Makro, hypertextový odkaz

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

VBApomoc
nováček
Příspěvky: 4
Registrován: červen 20
Pohlaví: Muž
Stav:
Offline

Makro, hypertextový odkaz

Příspěvekod VBApomoc » 12 čer 2020 16:26

Dobrý den,

Mohl bych tu někoho zkušeného s VBA požádat o pomoc? Potřeboval vytvořit hypertextový odkaz v listu2, kde by byl text KlikniZDE. Po kliknutí by se otevřela www stránka, která by se ale dynamicky měnila podle obsahu buňky v listu1.

Moc děkuji za pomoc

Reklama
Uživatelský avatar
atari
Level 6
Level 6
Příspěvky: 3195
Registrován: říjen 08
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod atari » 12 čer 2020 21:54

To chceš 2 různé věci. Hypertextový odkaz lze vytvořit pomécí makra - VBA. Ale www stránku pomocí VBA nevytvoříš.

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod elninoslov » 12 čer 2020 22:01

To stačí vzorcom:

Kód: Vybrat vše

=HYPERLINK(List1!A1;"KlikniZDE")
=HYPERTEXTOVÝ.ODKAZ(List1!A1;"KlikniZDE")


EDIT:
Aha, tak to ma nenapadlo, že to môže byť myslené aj takto.

VBApomoc
nováček
Příspěvky: 4
Registrován: červen 20
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod VBApomoc » 12 čer 2020 22:24

Vytvořit webovou stránku nechci a vím, že na to se VBA nepoužívá, zase tak mimo nejsem :lol: Potřebuji to zapsat pomocí makra, aby buňka v listu 2 nic neobsahovala a dala se kdykoliv přepsat, ale přes tlačítko se zase hyp.odkaz obnovil. Na internetu jsem našel pár kódu, ale žádný mi ve finále nefungoval.

Děkuji za radu

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod elninoslov » 13 čer 2020 10:02

Príloha ako to vyzerá?
Načo príloha? Aby sme vedeli akej oblasti sa to týka, z hľadiska možnej automatizácie nastaviť činnosť do Worksheet_Change.
Takže bunka môže nadobudnúť:
a) prázdna - prípadný HL sa z nej zmaže (viď vyššie Worksheet_Change)
b) bez zmysluplných dát, ale s textom "KlikniZDE" spolu s HL, ktorý sa vytvorí na základe stlačenia čudlíku alebo nejakým iným podnetom napr. inej bunky pomocou Worksheet_Change
c) užívateľom dopísané data, čo musí mať opäť za následok zmazanie HL v tej bunke už existujúceho
d) ...

EDIT:
Niečo ako:

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        On Error Resume Next
        With Range("A1")
            .Hyperlinks(1).Delete
            .Font.ColorIndex = xlAutomatic
            .Font.Underline = False
        End With
    End If
End Sub

Kód: Vybrat vše

Sub Create_HyperLink()
Dim Adr As String
    Adr = Worksheets("List1").Range("A1").Value
    Application.EnableEvents = False
    With Worksheets("List2")
        .Hyperlinks.Add Anchor:=.Range("A1"), Address:=Adr, ScreenTip:=Adr, TextToDisplay:="KlikniZDE"
    End With
    Application.EnableEvents = True
End Sub

VBApomoc
nováček
Příspěvky: 4
Registrován: červen 20
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod VBApomoc » 15 čer 2020 14:53

Zdravím,

Super, moc děkuji za pomoc. Druhý varianta funguje : Sub Create_HyperLink()

Sice to je mimo téma, ale řeším ještě jeden podstatný problém. Pracuji ve dvou souborech současně a z jednoho načítám data do druhého. Dělám to pomocí ThisWorksheet Activate a potom Worksheet.Open. Což mi funguje, ale pokaždé když si chci něco načíst, tak nesmím zapomenout druhý soubor uložit. Což se mi pořád děje a pak mi excel spadne. Nejde tohle nějak ošetřit?
Ještě doplním že druhý soubor, ze kterého načítám data je sdílený.

Děkuji

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod elninoslov » 15 čer 2020 15:19

Tie procedúry sú potrebné obidve. Jedna vytvára samotný hyperlink a druhá kontroluje, či sa daná bunka nezmazala, a zmaže hyperlink a formátovanie. Tú adresu si treba ešte poriešiť podľa seba, alebo napíšte akej oblasti sa to týka v prípade viac buniek. To niesú 2 rôzne spôsoby :)
Create_HyperLink ide do normálneho modulu, a Worksheet_Change do modulu daného listu.

Čo sa týka druhého problému. Popis je nedostatočný, a bodla by príloha (citlivé data zmažte). Nevieme, čo znamená "načítám data". Záleží na tom, čo tam presne robíte, aké rozsahy, aké formáty, aké množstvo, podmienky, ... a dalo by sa možno data získavať inak (dočasné vzorce, PowerQuery, ExecuteExcel4Macro,...).

VBApomoc
nováček
Příspěvky: 4
Registrován: červen 20
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod VBApomoc » 15 čer 2020 15:30

kód vypadá takto:

Sub načti data
Const Cesta = "G:\..."

HPO = Worksheets("Data").Range("B1")

Workbooks.Open (Cesta)
On Error Resume Next

DN = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 5, False)
DV = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 11, False)
CN = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 7, False)
CV = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 12, False)
ZK = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 4, False)
NPSC = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 9, False)
NM = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 10, False)
NZ = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 8, False)
VPSC = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 14, False)
VZ = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 13, False)
VM = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 15, False)
kus = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 18, False)
rozmery = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 17, False)
vaha = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 20, False)
dopravce = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 22, False)
LDM = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 16, False)
cena = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 26, False)
mena = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 27, False)
KN = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 2, False)
SPZ = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 21, False)
disponentplan = WorksheetFunction.VLookup(HPO, Worksheets("06 Červen").Range("B4:AJ1000"), 34, False)
End sub

To je vlastně všechno. Zmáčknu tlačítko načti data a přesenou se data do prvního souboru. Jenže pokud si to předtím než načtu data neuložím, tak to spadne. Napadlo mě to řešit vložením příkazu na uložení. Aby se provedlo otevření a hned uložení?

Děkuji

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: Makro, hypertextový odkaz

Příspěvekod elninoslov » 15 čer 2020 18:05

Ja by som ten súbor neotváral a použil by som "dolovanie" dočasnými vzorcami do pomocnej oblasti, ktoré sa ihneď po načítaní zmažú. Oblasť D1:AL1. Alebo by som mal stále aktuálne vypočítavané údaje ako v D2:AL2.

Kód: Vybrat vše

Sub Nacti_data()
Dim A(), rngHelp As Range, i As Integer
Dim Cesta As String, Subor As String, LST As String, Adresa As String, HPO As String
   
    Cesta = "G:\"
    Subor = "Zdieľaný zdroj.xlsx"
    LST = "05 Květen"
    Adresa = "$B$4:$AJ$1000"
   
    Set rngHelp = ThisWorkbook.Worksheets("Data").Range("D1").Resize(, Range(Adresa).Columns.Count)
    HPO = ThisWorkbook.Worksheets("Data").Range("B1").Value

    With rngHelp
        .Formula = "=IFERROR(IF(VLOOKUP($B$1,'" & Cesta & "[" & Subor & "]" & LST & "'!" & Adresa & ",COLUMN(A1),FALSE)="""","""",VLOOKUP($B$1,'" & Cesta & "[" & Subor & "]" & LST & "'!" & Adresa & ",COLUMN(A1),FALSE)),"""")"
        A = .Value
        .ClearContents
    End With
   
    DN = A(1, 5)
    DV = A(1, 11)
    CN = A(1, 7)
    CV = A(1, 12)
    ZK = A(1, 4)
    NPSC = A(1, 9)
    NM = A(1, 10)
    NZ = A(1, 8)
    VPSC = A(1, 14)
    VZ = A(1, 13)
    VM = A(1, 15)
    kus = A(1, 18)
    rozmery = A(1, 17)
    vaha = A(1, 20)
    dopravce = A(1, 22)
    LDM = A(1, 16)
    cena = A(1, 26)
    mena = A(1, 27)
    KN = A(1, 2)
    SPZ = A(1, 21)
    disponentplan = A(1, 34)
End Sub
Přílohy
Nacti_Ext_Data.xlsm
(20.41 KiB) Staženo 47 x
Zdieľaný zdroj.xlsx
(14.4 KiB) Staženo 43 x


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Makro pro myš Rapture Python
    od mmmartin » 27 srp 2023 15:18 » v Problémy s hardwarem
    9
    1111
    od mmmartin Zobrazit poslední příspěvek
    29 srp 2023 16:47

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů