Çift tıklamayla Tablo adına köprü oluşturma veya gitme

[ermanusta]

Ana Sayfada A stünunda hücre içinde yazan adlara sahip tablolarım başka sayfalarda, sayfa isimleri farklı olabilir.
ben bu adlara çift tıklamayla tabloların bulunduğu sayfayı yani tabloyu görmeyi/aktif hale getirmeyi nasıl sağlayabilirim.
Tablo adına köprü oluşturulamıyorsa sayfa adına da olur

 

[Korhan Ayhan]

Konuyla ilgili küçük bir örnek dosya paylaşırsanız destek almanız kolaylaşır.

 

[ermanusta]

ön izleme için resim ekledim, bir de dosyayı ekledim.

 

[ermanusta]

Konuyla ilgili küçük bir örnek dosya paylaşırsanız destek almanız kolaylaşır.

Aşağıdaki gibi bi makrom var ama bu dış bağlantı yapıyor, bunu da hücre içindeki değerle beraber üzerine çift tıklayınca html için oluşturuyor
tablolara gitmem gerekiyor


If Selection.Count > 1 Then Exit Sub
If Target.Column = 17 And Target.Row > 1 Then
Yol = Range("AJ1")
Hyperlinks.Add Anchor:=Target, Address:=Yol & "KPG" & Left(Target.Value, 2) & "000" & Mid(Target.Value, 3) & ".html"

 

[alicimri]

git.xlsm dosyasını indir - download

git.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

örnek dosyanın işeyiş ve yapısı,
Sayfa1 de A sütunundaki veri olan hücrelere çift tıklayınca Sayfa2 ve Sayfa3 de temsili tabloların ilk hücresine gidiyor.
Kodlar Sayfa1 in kod modülünde
Formüller menüsünde Ad Yöneticinde temsili tabloların ilk hücresi için ilk, son gibi ad oluşturdum.

 

[alicimri]

Aslında makroya da gerek yok ad tanımları örnek dosyadaki gibi yaptıktan sonra Sayfa birde A sütunundaki hücrelerde sağ tıklayıp, Köprü yü seçip orada Bu Belgeye Yerleştir de oluşturulmuş adlardan birini seçin.

 

[ermanusta]

Konuyla ilgili küçük bir örnek dosya paylaşırsanız destek almanız kolaylaşır.

Aşağıdaki gibi bi makrom var ama bu dış bağlantı yapıyor, bunu da hücre içindeki değerle beraber üzerine çift tıkla

If Selection.Count > 1 Then Exit Sub
If Target.Column = 17 And Target.Row > 1 Then
Yol = Range("AJ1")
Hyperlinks.Add Anchor:=Target, Address:=Yol & "GIB20" & Left(Target.Value, 2) & "000" & Mid(Target.Value, 3) & ".html"

 

[ermanusta]

Aslında makroya da gerek yok ad tanımları örnek dosyadaki gibi yaptıktan sonra Sayfa birde A sütunundaki hücrelerde sağ tıklayıp, Köprü yü seçip orada Bu Belgeye Yerleştir de oluşturulmuş adlardan birini seçin.

Evet haklısınız şu an aynen dediğiniz gibi yapıyorum ama 800 adet kadar satır, 4 adet sütunda aynı işlemi yapmak için 3600 işlem yapmam gerekli bunu makroyla yapabilirsem daha hızlı olabilirim.

 

[ermanusta]

git.xlsm dosyasını indir - download

git.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

örnek dosyanın işeyiş ve yapısı,
Sayfa1 de A sütunundaki veri olan hücrelere çift tıklayınca Sayfa2 ve Sayfa3 de temsili tabloların ilk hücresine gidiyor.
Kodlar Sayfa1 in kod modülünde
Formüller menüsünde Ad Yöneticinde temsili tabloların ilk hücresi için ilk, son gibi ad oluşturdum.

Güzel işlemişsiniz, fakat bunu son gibi adı tabloların ilk hücresi için değil de. tabloların adları için kullanabilir miyiz. çünkü tüm tabloların adları mevcutta var ve aslında teknik olarak bağlantı da oluşturulabiliyor.

 

[alicimri]

Ana Sayfada A sütununda hücrede yazan tablo adlarını çift tıklayın, o tabloyu seçiyor, ayrıca ad tanımlamanıza gerek yok.
Tablo adları, tanımlı ad olmadığından, köprü kurulamıyor.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
adi = Target
For i = 1 To Sheets.Count
Sheets(i).Activate
For e = 1 To ActiveSheet.ListObjects.Count
If adi = ActiveSheet.ListObjects(e).Name Then
ActiveSheet.Range(adi & "[#All]").Select
Exit Sub
End If
Next
Next
End Sub

 

[alicimri]

Ana Sayfa A sütununda bulunan tablo isimlerine köprü kuruluyor.

Sub TableByName()
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
    If Cells(i, 1).Value <> "" Then
    Dim TableName As String
    TableName = Cells(i, 1).Value
    Dim tbl As ListObject
    On Error Resume Next
    Set tbl = Range(TableName).ListObject
    If tbl Is Nothing Then Exit Sub
    With tbl
    If InStr(Test, .Range.Address) = 0 Then
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:=.Range.Worksheet.Name & "!" & Split(.Range.Address, ":")(0), TextToDisplay:=Cells(i, 1).Value
    Test = Test & .Range.Address
    End If
    End With
    End If
    Next
End Sub

 

[ermanusta]

Ana Sayfada A sütununda hücrede yazan tablo adlarını çift tıklayın, o tabloyu seçiyor, ayrıca ad tanımlamanıza gerek yok.
Tablo adları, tanımlı ad olmadığından, köprü kurulamıyor.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
adi = Target
For i = 1 To Sheets.Count
Sheets(i).Activate
For e = 1 To ActiveSheet.ListObjects.Count
If adi = ActiveSheet.ListObjects(e).Name Then
ActiveSheet.Range(adi & "[#All]").Select
Exit Sub
End If
Next
Next
End Sub

Bu kodu denedim örnek bir çalışma kitabında doğru çalıştı fakat olmasını istediğim çalışma kitabında kullanmaya kalktığımda çalıştıramadım. önce tüm sayfaları (ki sayfa sayısı oldukça fazla haliyle tabloda fazla) açıp aradı fakat bulamadan bir sayfada takılı kaldı. başka tablolara yönlendirdim ama çalıştıramadım

For e = 1 To ActiveSheet.ListObjects.Count

burada hata veriyor

 

[alicimri]

Aşağıdaki kodlarda Sheets("Sayfa1") daki Sayfa adını kendinizin Ana sayfa adı ile değiştirin ve bu kodu bir kere çalıştırın. Ana sayfanız A sütununa tablolarınızın adları listelenecektir. Çalıştığında sorun çıkarttığını söylediğiniz kodları tekrar deneyin.

 Sub TabloAdı()
a = 1
For i = 1 To Sheets.Count
Sheets(i).Activate
For e = 1 To ActiveSheet.ListObjects.Count
Sheets("Sayfa1").Cells(a, 1).Value = ActiveSheet.ListObjects(e).Name
a = a + 1
Next
Next
End Sub

 

[ermanusta]

Aşağıdaki kodlarda Sheets("Sayfa1") daki Sayfa adını kendinizin Ana sayfa adı ile değiştirin ve bu kodu bir kere çalıştırın. Ana sayfanız A sütununa tablolarınızın adları listelenecektir. Çalıştığında sorun çıkarttığını söylediğiniz kodları tekrar deneyin.

 Sub TabloAdı()
a = 1
For i = 1 To Sheets.Count
Sheets(i).Activate
For e = 1 To ActiveSheet.ListObjects.Count
Sheets("Sayfa1").Cells(a, 1).Value = ActiveSheet.ListObjects(e).Name
a = a + 1
Next
Next
End Sub

a = a + 1 de out of range hatası alıyorum

 

[alicimri]

En üsteki Option Explicit silip, deneyin.

 

[alicimri]

Ben Altın üye değilim dosyanızı göremiyorum. Tcdosya gibi bir paylaşım sitesi ile eklerseniz.