Excel-VBA-generování obsahu-pomoc s úpravou

[Jan Pašek]

pokouším se upravit následující makro viewtopic.php?p=233831&sid=c7c7630331db69913294ff25926c706d#p233831 a opět v tom plavu.

tohle sem napsal (viz Code) a nechodí podmínka za "Else" pokud nemá list číslo uvedené v podmínce chci aby se zapsal v ýstup vzorce z buňky Q4 dotčeného listu

Kód: Vybrat vše

Sub seznam_listu()
Dim ceLL As Range
Columns(1).ClearContents
For i = 1 To Sheets.Count
    If i < 6 Or i = 7 Or i = 8 Then
        Cells(i, 1) = Sheets(i).Name
    Else
        Cells(i, 1) = Sheets(i).ceLL(4, 17)
    End If
Next
End Sub

další část upravovaného makra bude navazovat ale taky trochu jinak jen dnes již došel volný čas takže potom navážu. zatím dík za pomoc s problémem výše.

[Reklama]

[Azuzula]

Tak první problém je v syntaxi onoho nefunkčního řádku... nevím proč tam definuješ proměnnou ceLL když ji pak necháš prázdnou a snažíš se ji i špatně použít. Když je snažší "Sheets(i).cells(4, 17)" nebo "Sheets(i).range("Q4")"
A další (není to chyba jen to vypadá blbě) bych zjednodušila If, není třeba tam mít 3 podmínky na to samé když stačí jedna "i <= 8" nebo "i < 9" vyber si, výsledek je stejný.

[Jan Pašek]

Tak naposled když jsem měl čas se tabulce co píšu věnovat mi spadnul internet takže to vypadá že sem pěkný nevděčník a zapomněl sem vyslovit mnohé díky.
Makro nyní vypadá takto:

Kód: Vybrat vše

Sub seznam_listu()
Dim ceLL As Range
If Range("A3") <> "Obsah knihy revizní a kontrol el.spotřebičů během užívání" Then
    Range("A3") = "Obsah knihy revizní a kontrol el.spotřebičů během užívání"
End If
If Range("A4") <> "Název listu" Then
    Range("A4") = "Název listu"
End If
If Range("B4") <> "Pořadí listu" Then
    Range("B4") = "Pořadí listu"
End If
For i = 2 To Sheets.Count
    If i < 8 Then
        Cells(i + 3, 1).ClearContents
        Cells(i + 3, 1) = Sheets(i).Name
        Cells(i + 3, 2).ClearContents
        Cells(i + 3, 2) = i
    Else
        Cells(i + 3, 1).ClearContents
        Cells(i + 3, 1) = Sheets(i).Range("Q4")
        Cells(i + 3, 2).ClearContents
        Cells(i + 3, 2) = i
    End If
Next i
For Each ceLL In Range("A5", Range("A5").End(xlDown))
    ceLL.Hyperlinks.Add anchor:=ceLL, Address:="", _
    SubAddress:="'" & ceLL.Value & "'" & "!a1", ScreenTip:="Kliknutím se přesuneš do tohoto listu", TextToDisplay:=ceLL.Value
Next
End Sub


Do horních řádků přijdou umístit ovládací tlačítka. Dále nevím jak upravit bo výše uvedený vzor předpokládá shodu mezi názvem listu a číslem listu já se ale odkazuji od 8 mého listu na buňku odtud jsou pak hypertext odkazy nefunkční.
Ještě Edit:
Od listu č 7 potřebuji odkazovat na první prázdnou buňku po poslední editované buňce ve sloupci A

[Jan Pašek]

najde se prosím někdo kdo poradí nebo je další požadavek na úpravu příliš nesrozumitelný?

[cmuch]

Ahoj, tak jsem něco vytvořil, jen si nejsem jistý tím jestli jsem zprávně pochopil

Od listu č 7 potřebuji odkazovat na první prázdnou buňku po poslední editované buňce ve sloupci A

Tak se uvidí

Kód: Vybrat vše

Sub seznam_listu()

Dim i As Integer
Dim FrstEmptyRow As Long

Sheets(1).Select ' zde napsat list na kterem se ma makro vykonat - zde prvni

Range("A3") = "Obsah knihy revizní a kontrol el.spotøebièù bìhem užívání"
Range("A4") = "Název listu"
Range("B4") = "Poøadí listu"

For i = 2 To Sheets.Count
    If i < 8 Then
        ' nazev listu dle bunky
        Cells(i + 3, 1).ClearContents
        Cells(i + 3, 1) = Sheets(i).Name
        ' hyper.odkaz
        Cells(i + 3, 1).Hyperlinks.Add Anchor:=Cells(i + 3, 1), Address:="", _
           SubAddress:="'" & Cells(i + 3, 1).Value & "'" & "!a1", _
           ScreenTip:="Kliknutím se pøesuneš do tohoto listu", _
           TextToDisplay:=Cells(i + 3, 1).Value
        ' poradi listu
        Cells(i + 3, 2).ClearContents
        Cells(i + 3, 2) = i
    Else
        ' nazev listu dle bunky
        Cells(i + 3, 1).ClearContents
        Cells(i + 3, 1) = Sheets(i).Range("Q4")
        ' prvni prázdna bunka v sl. A na listu i
        FrstEmptyRow = Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row + 1
        ' hyper.odkaz
        Cells(i + 3, 1).Hyperlinks.Add Anchor:=Cells(i + 3, 1), Address:="", _
           SubAddress:="'" & Sheets(i).Name & "'" & "!a" & FrstEmptyRow, _
           ScreenTip:="Kliknutím se pøesuneš do tohoto listu", _
           TextToDisplay:=Cells(i + 3, 1).Value
        ' poradi listu
        Cells(i + 3, 2).ClearContents
        Cells(i + 3, 2) = i
    End If
Next i
End Sub

Jen je ještě potřeba upravit názvy buněk A3, A4, B4 - code asi neumí některá písmena s háčkama.