Új hozzászólás Aktív témák

  • Mutt

    senior tag

    válasz andreas49 #48984 üzenetére

    Szia,

    Ezt próbáld meg. A kommentek alapján tudod módosítani.

    Sub vissza()
    Dim wsTOC As Worksheet
    Dim ws As Worksheet
    Dim i As Long, c As Long
    Dim result As Range
    Dim back As Range

    'a munkalap neve, ahíol megtalálhatók a lapok nevei, ezt javítsd a megfelelőre
    Const TOC = "Start"

    Set wsTOC = Worksheets(TOC)

    'végig futunk a munkalapokon
    For i = 1 To Worksheets.Count
    Set ws = Worksheets(i)

    'csak más nevű munkalapok érdekelnek
    If ws.Name <> TOC Then
    'keressük meg helyét a munkalapnak az összesítőn
    Set result = wsTOC.Range("A:A").Find(ws.Name)

    'ha nincs meg akkor ugorjuk át
    If Not result Is Nothing Then
    Set back = ws.Range("A2")

    'ha üres lenne a cella akkor írjuk bele ezt, ha nem kell akkor töröld ki
    If back = "" Then back = "vissza"

    'ha már lenne hivatkozás, akkor töröljük a korábbit
    If back.Hyperlinks.Count > 0 Then back.Hyperlinks.Delete

    'adjuk hozzá a linket
    back.Hyperlinks.Add Anchor:=back, Address:="", SubAddress:="'" & TOC & "'!" & result.Address
    End If
    End If
    Next i

    'nem kötelező de szüntessük meg az objektumokat
    Set back = Nothing
    Set result = Nothing
    Set ws = Nothing
    Set wsTOC = Nothing
    End Sub

    üdv

Új hozzászólás Aktív témák