• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

"Prehled" nie je "Přehled" !
Sub TiskDoPdf()
Dim Mesic As Integer, OldSelect As Worksheet
Mesic = Sheets("Měsíc").Range("A1").Value
Set OldSelect = ActiveSheet
Sheets("Přehled").PageSetup.PrintArea = Sheets("Přehled").Range("A1:I50").Offset(0, (Mesic - 1) * 9).Address
Sheets(Array("A", "B", "C", "D", "Přehled")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\users\slay\desktop\TISK DO PDF\" & Mesic & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
OldSelect.Select
End Sub

Veď to spravte naraz, aj linky aj hodnoty.

Heh, no na to pivko vezmite niekoho bližšieho, ja som z SK. Teda ak nájdete niečo otvorené najbližšie mesiace :(
V CZ som bol naposledy v Ostrave pred 2 rokmi...
Užite v zdraví. Reportnite prípadné chyby z praxe, poriešime.

To nebude problém. Vytvoríme rekurzívnu (do seba sa opakovane vnárajúcu) procedúru. Zosumarizujme si čo potrebujete:
A - celá cesta k súboru
B - veľkosť súboru
C, D, E, F, ... postupne toľko stĺpcov koľko je podadresárov, každý stĺp jeden podadresár ???

Skúste. Je to aj s popisom (ignorujte pls gramatické chybky).

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.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse