To nebude problém. Len ak vkladáte prílohu XLSM musíte ju zabaliť do ZIP/RAR.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Makro kopie listu + hypertext
Ok, děkuji a mohl bych poprosit o kód. Přílohu jsem opravil.citovat
Děkuji, je to super. Ta změna názvu podle listu byla první varianta, kterou jsem to chtěl řešit, ale nakonec to zvládne vaše makro. Do bunky A3 mně to ale vkládá název to bych chtěl z makra zrusit. Co bych ale potřeboval a bylo by to dokonale, kdyby to umelo vlozit na nově vytvořený list do bunky B10 číslo, které je uvedené na stejném řádku ve skoupci A v seznamu. Příklad: na listu "seznam" pustím makro na bunce C4 a makro probehne jako nyní jen jeste vlozi na nový list do bunky B10 obsah bunky A4 z listu "seznam". Tak to by to bylo automatizovane uplne TOP dle mých předtav. Upraveny soubor přikládám a jeste moc prosím o úpravu.
Otestoval jsem a funguje perfektně. Koukal jsem, že jste upravil i kódy u navigace. Snad jste z Brna můžu se revanšovat třeba u pivka. :-) Ještě jednou děkuju moc a jste fakt king.citovat
MS Excel
Téma: Makro kopie listu + hypertext 
Zaslal/a Morfeuss 25.2.2021 8:44
Dobrý den, v makrech a vba se vůbec nevyznám, tak Vás zkušené poprosím o radu s vytvořením tohoto makra.
Potřeboval bych aby makro, které spustím na aktivní buňce ve sloupci A na listu Seznam udělalo kopii listu VZOR s umístěním na konec sešitu, pojmenovalo ho shodně s obsahem aktivní buňky ve sloupci A + vytvořilo hypertextový odkaz na tento nový list.
Vzor přikládám a bylo by to takto možné?
Děkuji
Příloha: 
49944_sesit1.rar (21kB, staženo 14x)
49944_sesit1.rar (21kB, staženo 14x)elninoslov napsal/a:
To nebude problém. Len ak vkladáte prílohu XLSM musíte ju zabaliť do ZIP/RAR.
Ok, děkuji a mohl bych poprosit o kód. Přílohu jsem opravil.citovat
Spravil som to takto:
-overuje existenciu listu
-ak list existuje, overí či odkaz v tej bunke sedí s textom v bunke a prípadne odkaz opraví
-ignoruje prázdne bunky
-funguje na multioblasť
-spúšťa sa skratkou Ctrl+M
Sub Vytvor_list()
Dim Are As Range, Bunka As Range, H(), x As Integer, y As Long, idx As Integer
If TypeName(Selection) <> "Range" Then MsgBox "Vyberte oblast buněk.", vbExclamation: Exit Sub
idx = Worksheets.Count
Application.ScreenUpdating = False
For Each Are In Selection.Areas
If Are.Cells.Count = 1 Then ReDim H(1 To Are.Rows.Count, 1 To Are.Columns.Count): H(1, 1) = Are.Value Else H = Are.Value
For y = 1 To UBound(H, 1)
For x = 1 To UBound(H, 2)
If Not IsEmpty(H(y, x)) Then
Set Bunka = Are.Cells(y, x)
With Bunka
If Kontrola_NeExistence(CStr(H(y, x))) Then
If .Hyperlinks.Count > 0 Then
If Not Range(.Hyperlinks(1).SubAddress).Parent.Name = H(y, x) Then .Hyperlinks.Add Anchor:=Bunka, Address:="", SubAddress:="'" & H(y, x) & "'!A1", ScreenTip:=H(y, x)
End If
Else
wsVZOR.Copy After:=Worksheets(idx)
ActiveSheet.Name = H(y, x)
ActiveSheet.Range("A3") = H(y, x)
.Hyperlinks.Add Anchor:=Bunka, Address:="", SubAddress:="'" & H(y, x) & "'!A1", ScreenTip:=H(y, x)
idx = idx + 1
End If
End With
End If
Next x
Next y
Next Are
wsSeznam.Activate
Application.ScreenUpdating = True
End Sub
Function Kontrola_NeExistence(sName As String) As Boolean
On Error Resume Next
Kontrola_NeExistence = Len(Worksheets(sName).Name)
End Function
Vy tam máte ale ešte makro, ktoré Vám pri zmene bunky A3 v ktoromkoľvek liste zmení jeho názov na zmenenú hodnotu.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
ActiveSheet.Name = Range("a3").Value
End Sub
Tu vidím veľký problém v tých odkazoch. Vy keď zmeníte názov listu zmenením tej bunky A3, tak Vám prestane správne odkazovať link v liste Seznam.
-overuje existenciu listu
-ak list existuje, overí či odkaz v tej bunke sedí s textom v bunke a prípadne odkaz opraví
-ignoruje prázdne bunky
-funguje na multioblasť
-spúšťa sa skratkou Ctrl+M
Sub Vytvor_list()
Dim Are As Range, Bunka As Range, H(), x As Integer, y As Long, idx As Integer
If TypeName(Selection) <> "Range" Then MsgBox "Vyberte oblast buněk.", vbExclamation: Exit Sub
idx = Worksheets.Count
Application.ScreenUpdating = False
For Each Are In Selection.Areas
If Are.Cells.Count = 1 Then ReDim H(1 To Are.Rows.Count, 1 To Are.Columns.Count): H(1, 1) = Are.Value Else H = Are.Value
For y = 1 To UBound(H, 1)
For x = 1 To UBound(H, 2)
If Not IsEmpty(H(y, x)) Then
Set Bunka = Are.Cells(y, x)
With Bunka
If Kontrola_NeExistence(CStr(H(y, x))) Then
If .Hyperlinks.Count > 0 Then
If Not Range(.Hyperlinks(1).SubAddress).Parent.Name = H(y, x) Then .Hyperlinks.Add Anchor:=Bunka, Address:="", SubAddress:="'" & H(y, x) & "'!A1", ScreenTip:=H(y, x)
End If
Else
wsVZOR.Copy After:=Worksheets(idx)
ActiveSheet.Name = H(y, x)
ActiveSheet.Range("A3") = H(y, x)
.Hyperlinks.Add Anchor:=Bunka, Address:="", SubAddress:="'" & H(y, x) & "'!A1", ScreenTip:=H(y, x)
idx = idx + 1
End If
End With
End If
Next x
Next y
Next Are
wsSeznam.Activate
Application.ScreenUpdating = True
End Sub
Function Kontrola_NeExistence(sName As String) As Boolean
On Error Resume Next
Kontrola_NeExistence = Len(Worksheets(sName).Name)
End Function
Vy tam máte ale ešte makro, ktoré Vám pri zmene bunky A3 v ktoromkoľvek liste zmení jeho názov na zmenenú hodnotu.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
ActiveSheet.Name = Range("a3").Value
End Sub
Tu vidím veľký problém v tých odkazoch. Vy keď zmeníte názov listu zmenením tej bunky A3, tak Vám prestane správne odkazovať link v liste Seznam.
Příloha: 49948_vytvareni-listu-ze-vzoru-s-hyperlinkem.zip (21kB, staženo 13x)
citovat49948_vytvareni-listu-ze-vzoru-s-hyperlinkem.zip (21kB, staženo 13x)elninoslov napsal/a:
Spravil som to takto:
-overuje existenciu listu
-ak list existuje, overí či odkaz v tej bunke sedí s textom v bunke a prípadne odkaz opraví
-ignoruje prázdne bunky
-funguje na multioblasť
-spúšťa sa skratkou Ctrl+M
Sub Vytvor_list()
Dim Are As Range, Bunka As Range, H(), x As Integer, y As Long, idx As Integer
If TypeName(Selection) <> "Range" Then MsgBox "Vyberte oblast buněk.", vbExclamation: Exit Sub
idx = Worksheets.Count
Application.ScreenUpdating = False
For Each Are In Selection.Areas
If Are.Cells.Count = 1 Then ReDim H(1 To Are.Rows.Count, 1 To Are.Columns.Count): H(1, 1) = Are.Value Else H = Are.Value
For y = 1 To UBound(H, 1)
For x = 1 To UBound(H, 2)
If Not IsEmpty(H(y, x)) Then
Set Bunka = Are.Cells(y, x)
With Bunka
If Kontrola_NeExistence(CStr(H(y, x))) Then
If .Hyperlinks.Count > 0 Then
If Not Range(.Hyperlinks(1).SubAddress).Parent.Name = H(y, x) Then .Hyperlinks.Add Anchor:=Bunka, Address:="", SubAddress:="'" & H(y, x) & "'!A1", ScreenTip:=H(y, x)
End If
Else
wsVZOR.Copy After:=Worksheets(idx)
ActiveSheet.Name = H(y, x)
ActiveSheet.Range("A3") = H(y, x)
.Hyperlinks.Add Anchor:=Bunka, Address:="", SubAddress:="'" & H(y, x) & "'!A1", ScreenTip:=H(y, x)
idx = idx + 1
End If
End With
End If
Next x
Next y
Next Are
wsSeznam.Activate
Application.ScreenUpdating = True
End Sub
Function Kontrola_NeExistence(sName As String) As Boolean
On Error Resume Next
Kontrola_NeExistence = Len(Worksheets(sName).Name)
End Function
Vy tam máte ale ešte makro, ktoré Vám pri zmene bunky A3 v ktoromkoľvek liste zmení jeho názov na zmenenú hodnotu.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
ActiveSheet.Name = Range("a3").Value
End Sub
Tu vidím veľký problém v tých odkazoch. Vy keď zmeníte názov listu zmenením tej bunky A3, tak Vám prestane správne odkazovať link v liste Seznam.Příloha: 49948_vytvareni-listu-ze-vzoru-s-hyperlinkem.zip (21kB, staženo 2x)
Děkuji, je to super. Ta změna názvu podle listu byla první varianta, kterou jsem to chtěl řešit, ale nakonec to zvládne vaše makro. Do bunky A3 mně to ale vkládá název to bych chtěl z makra zrusit. Co bych ale potřeboval a bylo by to dokonale, kdyby to umelo vlozit na nově vytvořený list do bunky B10 číslo, které je uvedené na stejném řádku ve skoupci A v seznamu. Příklad: na listu "seznam" pustím makro na bunce C4 a makro probehne jako nyní jen jeste vlozi na nový list do bunky B10 obsah bunky A4 z listu "seznam". Tak to by to bylo automatizovane uplne TOP dle mých předtav. Upraveny soubor přikládám a jeste moc prosím o úpravu.
Příloha: 49949_vytvareni-listu-ze-vzoru-s-hyperlinkem-2.rar (18kB, staženo 13x)
citovat49949_vytvareni-listu-ze-vzoru-s-hyperlinkem-2.rar (18kB, staženo 13x)Sakra, akurát som to všetko upravil, aj sprevádzkoval technicky (pamätanie si predchádzajúceho názvu a opravenie linku) aj logicky, idem to poslať, a Vy bác zmena 
1. Takže v tom liste nebude nikde bunka s názvom daného listu, pri ktorej zmene by sa premenoval list a opravil link v "Seznam"?
2. V Seznam v stĺpe A je to, čo pôjde ako názov listu, a v C je to čo pôjde do B10?
PS: Odstráňte citáciu z príspevku, je jasné na čo reagujete, citáciu netreba.citovat
1. Takže v tom liste nebude nikde bunka s názvom daného listu, pri ktorej zmene by sa premenoval list a opravil link v "Seznam"?
2. V Seznam v stĺpe A je to, čo pôjde ako názov listu, a v C je to čo pôjde do B10?
PS: Odstráňte citáciu z príspevku, je jasné na čo reagujete, citáciu netreba.citovat
Omlouvám se za komplikace, ale netušil jsem ze mně toto vyřeší jedno makro.
Ad 1) nee nebude, už není potřeba, vyřešil jste to makrem kde se list pojmenuje podle toho z jaké buňky je makro spuštěno.
Ad 2) V seznamu je to co půjde jako název listu z buňek ve sloupci C (např: abcde) a do buňky B10 v novém makrem vytvořeném listu se dotáhne buňka ze sloupce A stejného řádku (dle příkladu abcde = 12345).
Děkuji za čas a úpravu
Ad 1) nee nebude, už není potřeba, vyřešil jste to makrem kde se list pojmenuje podle toho z jaké buňky je makro spuštěno.
Ad 2) V seznamu je to co půjde jako název listu z buňek ve sloupci C (např: abcde) a do buňky B10 v novém makrem vytvořeném listu se dotáhne buňka ze sloupce A stejného řádku (dle příkladu abcde = 12345).
Děkuji za čas a úpravu
Příloha: 49951_vytvareni-listu-ze-vzoru-s-hyperlinkem-2.rar (18kB, staženo 11x)
citovat49951_vytvareni-listu-ze-vzoru-s-hyperlinkem-2.rar (18kB, staženo 11x)Otestujte. Vašu prílohu som nesťahoval. Ponechal som aj to premenovanie listu a aktualizáciu linku pri zmene A3. Dajte vedieť. Ale teraz idem na čas od PC ...
Příloha: 49953_vytvareni-listu-ze-vzoru-s-hyperlinkem-2.zip (34kB, staženo 16x)
citovat49953_vytvareni-listu-ze-vzoru-s-hyperlinkem-2.zip (34kB, staženo 16x)Přehodil jsem makro do svého souboru, ale nefunguje, seklo se to bohužel hned na začátku. Bude asi nejlepší když pošlu svůj soubor na kterém to budete moct odladit a budete moct potom i s makrem poslat zpět.
Děkuji a soubor je v příloze
Děkuji a soubor je v příloze
Příloha: 49954_reporting-nakup-2.rar (81kB, staženo 12x)
citovat49954_reporting-nakup-2.rar (81kB, staženo 12x)Skúste. Je to aj s popisom (ignorujte pls gramatické chybky).
Příloha: 49958_reporting-nakup-2.zip (90kB, staženo 16x)
citovat49958_reporting-nakup-2.zip (90kB, staženo 16x)elninoslov napsal/a:
Skúste. Je to aj s popisom (ignorujte pls gramatické chybky).Příloha: 49958_reporting-nakup-2.zip (90kB, staženo 2x)
Otestoval jsem a funguje perfektně. Koukal jsem, že jste upravil i kódy u navigace. Snad jste z Brna můžu se revanšovat třeba u pivka. :-) Ještě jednou děkuju moc a jste fakt king.citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články