Köprülerin adresi

[yyhy]

Köprülerin başvurduğu adres veya sayfa adlarını (örneğin b sütununa ) sütuna yazdırılabilir mi?

 

[netzone]

Merhaba,

Şöyle bir kod buldum işinizi görür sanırım, denedim Office 2019'da çalışıyor.

Örnek 1 :

Sub ExtractHL()
    Dim HL As Hyperlink
    For Each HL In ActiveSheet.Hyperlinks
        HL.Range.Offset(0, 1).Value = HL.Address
    Next
End Sub

Yada şunu kullanabilirsiniz.

Örnek 2:

Function GetURL(rng As Range) As String
    On Error Resume Next
    GetURL = rng.Hyperlinks(1).Address
End Function

Kullanımı; A1 içinde yer alan Linkin adresini öğrenmek için B1 e yazılacak kod:
=GetURL(A1)

İyi çalışmalar.

[Kodları Alıntıdır: Allen Wyatt ]

 

[yyhy]

Sayın netzone öncelikle teşekkür ederim. 350 sayfalık bir excel çalışma kitabım var. Sayfa isimlerini 00 01 02 03 .....350 ye kadar verdim. G sütununa da sayfa başlığında yer alan bilgileri girerek sayfalara köprü oluşturdum. B sütununa da (vermiş olduğunuz kodlar ile ) sayfa adlarını linkleri yazdırmak istiyorum. Bu kodlar yeterli olacak mı acaba?

 

[netzone]

Merhaba,

Test ederken dış bağlantı olarak test emiştim. (Örn: http://www... )
Çalışma kitabınız içindeki bağlantıların durumunu mesajınızdan sonra kontrol ettim malesef sayfa içindeki bağlantıları [Örn. 5.sayfanın B17 hücresi] bunu göstermiyor.

 

[netzone]

Merhaba,

Biraz araştırdıktan sonra Sayfa içindeki bağlantı yollarını göstermek için çözümü buldum, kodu aşağıdaki gibi değiştiriniz.

(Örnek: 00 sayfasının a1 hücresine verilen linki > '00'!A1 olarak gösterecektir.)
1. Yol: Kullanmak için makroyu çalıştırın, Linkin olduğu hücrenin sağındaki hücreye yazacaktır.

Sub ExtractHL()
    Dim HL As Hyperlink
    For Each HL In ActiveSheet.Hyperlinks
        HL.Range.Offset(0, 1).Value = HL.SubAddress
    Next
End Sub

*Dosyanızın yedeğini aldıktan sonra kontrol ediniz.

2.Yol: Kullanımı; A1 içinde yer alan Linkin adresini öğrenmek için B1 e yazılacak kod: =GetURL(A1)

Function GetURL(rng As Range) As String
    On Error Resume Next
    GetURL = rng.Hyperlinks(1).SubAddress
End Function

İyi çalışmalar.

 

[yyhy]

Kodları denedim çalıştıramadım. Office 2016 64 bit kullanıyorum. Sorun ne olabilir.

 

[yyhy]

Deneme örnek bir dosya ekleyebilirmisiniz.

 

[netzone]

Merhaba,

Örnek dosya ekte yer almaktadır.

iyi çalışmalar.

 

[yyhy]

Sayın netzone emeğiniz için teşekkürler. Küçük bir değişiklik yapılabilir mi? İsteğimi jpeg resim dosyası olarak ekliyorum.

 

[netzone]

Merhaba,

Yukarıda verdiğim 2 yoldan 2.sini seçmeniz doğrultusunda hücreye formülü yazdığınızda yerde sonuç aldığınız için sonuca daha kolay ulaşabilirsiniz.

2.Yol: Kullanımı; I8 içinde yer alan Linkin adresini öğrenmek için D8 e yazılacak kod: =GetURL(A1) Bu durumda sizin alacağınız sonuç şu şekilde olacaktır: '00'!A1 , bu sonuç içinden sadece 00'ı çekmek istiyorsanız hücreye şu formülü giriniz. =SOLDAN(GetURL(I8);BUL("!";(GetURL(I8));1)-2)

Rich (BB code):
Function GetURL(rng As Range) As String
    On Error Resume Next
    GetURL = rng.Hyperlinks(1).SubAddress
End Function

İyi çalışmalar.

 

[yyhy]

Formülde değişiklik yapılabilir mi?

 

[netzone]

Merhaba,

Hücre içine yazmış olduğunuz formülü şu şekilde değiştiriniz.
=EĞERHATA((SAĞDAN(SOLDAN(GetURL(I8);BUL("!";(GetURL(I8));1)-2);UZUNLUK(SOLDAN(GetURL(I8);BUL("!";(GetURL(I8));1)-2))-1));"")

*Söz konusu KOD içinde de aynı işlem yapılabilir fakat benim bilgim yetersiz kalıyor, belki arkadaşlarımız makroyu istediğiniz gibi düzenleyebilirler.

iyi çalışmalar.

 

[yyhy]

Teşekkürler örnek dosyaya uygulayacağım. Emeğinize sağlık.