İçindekiler Tablosu

Aşağıdaki kodlarla aktif çalışma sayfanıza İçindekiler Tablosu ekleyebilirsiniz. Bu kodlar aktif çalışma kitabınızdaki her sayfaya bir köprü oluşturur ve her sayfanın A1 hücresinden başlığı alır.

Sub Tablo_icindekiler()
'Bu prosedür, aktif çalışma sayfanıza içindekiler tablosu ekler. Her sayfaya bir köprü oluşturur ve her sayfanın A1 hücresinden başlığı alır.

    Dim Sayfa As Worksheet
    Dim BaslangicHucresi As Range 'inputbox için
    Dim SayfaAdi As String
    Dim MsgOnay As VBA.VbMsgBoxResult
    Dim BitisHucresi As Range 'msgbox bilgi için
    
    'kullanıcıdan bir hücre seçmesini iste
    On Error Resume Next
    Set BaslangicHucresi = Excel.Application.InputBox("İçindekiler Tablosunu nereye eklemek istersiniz?" & vbNewLine & "Lütfen hücreyi seçin:" _
                                , "İçindekiler Tablosu Ekle", , , , , , 8)
    If Err.Number = 424 Then Exit Sub
    On Error GoTo HATA:
                         
    Set BaslangicHucresi = BaslangicHucresi.Cells(1, 1)
    Set BitisHucresi = BaslangicHucresi.Offset(Worksheets.Count - 2, 1)
    
    'kullanıcının iptal etmesine izin ver, aksi takdirde hücrelerinin üzerine yazılabilir
    MsgOnay = MsgBox("Hücrelerdeki değerler: " & vbNewLine & _
    BaslangicHucresi.Address & " - " & BitisHucresi.Address & " hücreleri üzerine yazılacaktır." _
    & vbNewLine & "Devam etmek ister misiniz?", vbOKCancel + vbDefaultButton2, "Onay gereklidir")
    If MsgOnay = vbCancel Then Exit Sub
    
    For Each Sayfa In Worksheets
        SayfaAdi = Sayfa.Name
         BaslangicHucresi = SayfaAdi
        'eğer sayfa aktif sayfa değilse ve sayfa görünür durumdaysa döngüye dahil et
        If ActiveSheet.Name <> SayfaAdi Then
            If Sayfa.Visible = xlSheetVisible Then
                ActiveSheet.Hyperlinks.Add Anchor:=BaslangicHucresi, Address:="", SubAddress:= _
                 "'" & SayfaAdi & "'!A1", TextToDisplay:=SayfaAdi
                BaslangicHucresi.Offset(0, 1).Value = Sayfa.Range("A1").Value
                Set BaslangicHucresi = BaslangicHucresi.Offset(1, 0)
            End If 'eğer sayfa görünür durumdaysa
        End If 'eğer sayfa aktif sayfa değilse
    Next Sayfa

    Exit Sub
HATA:
MsgBox "bir hata oluştu!"

End Sub

Paylaş: