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

• #48988 Delila_1 veterán Mutt #48987

  Új Válasz 2022-05-09 06:37:24 #48988

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mutt #48987 üzenetére

  Írtam én is egy makrót – sok magyarázattal –, ami létrehozza a tartalomjegyzék lapot, és az egyes lapokra a visszaugrás csatolást.

  Sub Tartalomjegyzek()
    'A makró egy tetszőleges nevű munkalapot szúr be a meglévők elé.
    'Erre a munkalapra egy tartalomjegyzéket készít a többi munkalapot listázva,
    'hivatkozást is elhelyezve, amik az egyes munkalapok egy megadott cellájára mutatnak.
    'A lapokra vissza logikájú linket helyez el kérésre, egy megadott cellába.
    
    Dim TartalomLapnev As String, VisszaSzovege As String, VisszaHelye
    Dim aktiv As Integer, Vissza As Integer
    
    'Megkérdezi a felhasználótól, mi legyen a tartalomjegyzék munkalapjának a neve
    TartalomLapnev = InputBox("Mi legyen a tartalomjegyzék munkalapjának neve?", "Tartalomjegyzék munkalapjának neve")
    
    'Megkérdezi, szeretnénk-e vissza gombot elhelyezni a munkalapokon?
    Vissza = MsgBox("Legyen-e egy vissza logikájú link a munkalapokon?", 4, "Vissza logikájú link")
    
    'Ha igen, kérdezze meg, mi legyen a szöveg? pl. 0171:«
    'és hol legyen az egyes lapokon
    If Vissza = 6 Then
        VisszaHelye = InputBox("Hova kerüljön a vissza logikájú link a lapokon?" & vbLf & "Pl.: A1", "Vissza logikájú link helye")
        VisszaSzovege = InputBox("Mi legyen a vissza logikájú link felirata?" & vbLf & "Pl. « (bal Alt+0171), vagy Vissza", "Vissza logikájú link felirata")
    End If
    
    'Szúrjon be egy új munkalapot a meglévők elé a legelső helyre.
    ActiveWorkbook.Sheets.Add Before:=Worksheets(1)
    
    'Adja az új munkalapnak a felhasználó által megadott nevet
    Worksheets(1).Name = TartalomLapnev
    Range("B1") = TartalomLapnev
    Range("B1").Font.Size = 14
    
    'Menjen végig a munkalapokon ...
    For aktiv = 2 To ActiveWorkbook.Sheets.Count
      'Írjon sorszámot.
        Worksheets(1).Cells(aktiv, 1).Value = aktiv - 1 'sorszám

        'Adjon linket a lapokhoz
      With Worksheets(1)
            .Hyperlinks.Add Anchor:=.Cells(aktiv, 2), Address:="", _
                SubAddress:="'" & Worksheets(aktiv).Name & "'!" & VisszaHelye, TextToDisplay:=Worksheets(aktiv).Name
        End With
        
        'Ha kértünk Vissza linket, hozza létre a vissza logikájú linket a megadott cellába
        If Vissza = 6 Then
          With Worksheets(aktiv) 'itt adjuk meg, hogy a Vissza link melyik cellára álljon az első lapon
                .Hyperlinks.Add Anchor:=.Range(VisszaHelye), Address:="", _
                    SubAddress:="'" & TartalomLapnev & "'!B" & aktiv, TextToDisplay:=VisszaSzovege
                .Range(VisszaHelye).Font.Bold = True
            End With
        End If
    Next aktiv
End Sub

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