Bu bölümde yer alan 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 SubCode language: VB.NET (vbnet)