Příspěvky uživatele

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 ...

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.

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.

To nebude problém. Len ak vkladáte prílohu XLSM musíte ju zabaliť do ZIP/RAR.

???
A čo je výstupom toho odkazu na iný zošit, ak ten iný zošit neobsahuje hodnotu? Bunka s hodnotou "" ošetrené vzorcom? Alebo bunka s hodnotou 0 (takú návratovú hodnotu dostanete štandardne) ošetrená formátom? To je predsa zásadná informácia.
V tom mojom vzorci som počítal s tým "".
...(A1:A50<>"")...

Sub TlacPDF()
Dim Adresar As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
Adresar = .SelectedItems(1)
Adresar = Adresar & IIf(Right(Adresar, 1) = "\", "", "\")
ActiveSheet.Range("C2").Value = Adresar
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Adresar & "TlacPDF.pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End With
End Sub

Myslíte tlač z makra?
Sub TlacPDF()
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=.SelectedItems(1) & "\TlacPDF.pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End With
End Sub

Tak som si prešiel jedno MS fórum, a vyzerá to žiaľ zatiaľ tak, že bezradný nie sme len my, ale i samotný M$. Problém je častý, a s typickými radami od M$ (rozumejte na prd).

Iba maličká technická: Priradenie do premennej "i" je v prípade ďalšieho nespracovania zbytočné. Dajte rovno
Select Case MsgBox("testovat", vbYesNoCancel + vbQuestion, "test")

Tieto 3 súbory sú kombináciou čísel a písmen, a normálne mi fungujú.
(122)Mobis Labak ECU SW.docx
456 juhfsdf.docx
jaidf56.docx
Keď si nejaký iný premenujem na napr. 7A.docx, tiež normálne funguje.
Skúste dať v kóde BreakPoint-y (klik sivý pásik vľavo od kódu) na riadky
Bunka.Hyperlinks.Delete
a
Bunka.Value = Subor
Zadajte číslopísmenný názov (existujúci) a písnite na ktorom riadku to zastaví. Následne nechajte kód dobehnúť (hore zelené tlačítko Play), lebo by ostali vypnuté udalosti.
A písnite tú verziu Office.

Je to Worksheet_Change, teda udalosť listu. Takže to musí ísť do modulu daného listu (u Vás je to "List1 (Hárok1)"), nie do normálneho modulu.
EDIT:
A ešte, ak máte pevnú zložku, tak nemôžete použiť to, čo tam máte
Zlozka = ThisWorkbook.Path & "C:\Users\Lucka\OneDrive\Počítač\MO\Excel revizie upozornovanie\Revizie dokumenty\"
ale musí to byť bez toho "ThisWorkbook.Path"
Zlozka = "C:\Users\Lucka\OneDrive\Počítač\MO\Excel revizie upozornovanie\Revizie dokumenty\"
Lebo s tým, vlastne zreťazíte 2 cesty. Cestu k aktuálnemu súboru a cestu manuálne zadanú v reťazci. A vtedy Vám to nebude fachať, čo je jasné.

Prípadne prvý riadok kódu upravte na
Set Zmena = Intersect(ListObjects("Tabuľka1").DataBodyRange.Columns(3), Target)
a bude to kontrolovať iba 3 stĺpec objektu Tabuľka1, a nie celý stĺpec C.

Formátovanie, zlúčené bunky a pod, to jedine makrom, a to tak, že pri aktivácii daného súhrnného listu by prebehla aktualizácia. Inak to možné nie je. Vložte prílohu s pár listami, pár riadkami dát, a manuálne vytvorený požadovaný výsledok. Nech je jasné, či sú listy rovnakej šírky, či sa ku každému listu kopíruje aj jeho hlavičkový riadok alebo sú rovnaké, a množstvo iných vecí. Proste manuálne vyrobte požadovaný vzor a makro prispôsobíme...

Function EVAL_WORKDAY(Datum As Date, Dni As Long) As Date
Dim Rok As Long
Rok = Year(Datum)
EVAL_WORKDAY = Evaluate("=WORKDAY(" & CDbl(Datum) & "," & Dni & ",DATEVALUE(MID(SUBSTITUTE(""01/01*""&TEXT(DOLLAR((""4/""&" & Rok & ")/7+MOD(19*MOD(" & Rok & ",19)-7,30)*14%,)*7-5,""mm/dd"")&""*05/01*05/08*07/05*07/06*09/28*10/28*11/17*12/24*12/25*12/26*"",""*"",""/""&" & Rok & "),(ROW(1:12)-1)*10+1,10)))")
End Function

Ak sú nejaké premenné definované ako objekty, je programátorsky "čisté" ich zrušiť. VBA si takéto obyčajné objekty zruší samozrejme sama po skončení procedúry. Ale pre začiatočníka, je vhodne sa naučiť objekty vždy rušiť. Ono totiž objekt nemusí byť len FSO, ale aj niečo podstatne väčšie a zložitejšie, napr. taká aplikácia. Čo ak bude objektom skrytá inštancia Excelu, Outlooku, ... Tá zostane visieť na systémových prostriedkoch aj po zatvorení Excelu. Aplikácie sa ešte navyše musia najskôr zatvoriť. Krízovo sa zrovna aplikácie sa dajú zrušiť potom v Správcovi úloh, ale iný objekt nemusí.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje