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
Makro, hypertextový odkaz
Re: Makro, hypertextový odkaz
To chceš 2 různé věci. Hypertextový odkaz lze vytvořit pomécí makra - VBA. Ale www stránku pomocí VBA nevytvoříš.
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Makro, hypertextový odkaz
To stačí vzorcom:
EDIT:
Aha, tak to ma nenapadlo, že to môže byť myslené aj takto.
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.
Re: Makro, hypertextový odkaz
Vytvořit webovou stránku nechci a vím, že na to se VBA nepoužívá, zase tak mimo nejsem 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
Děkuji za radu
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Makro, hypertextový odkaz
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:
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
Re: Makro, hypertextový odkaz
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
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
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Makro, hypertextový odkaz
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,...).
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,...).
Re: Makro, hypertextový odkaz
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
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
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Makro, hypertextový odkaz
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
-
- 9
- 1111
-
od mmmartin
Zobrazit poslední příspěvek
29 srp 2023 16:47
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů