Hücre içerisine rölatif köprü eklemek

seckinbilgic · 1 Eyl 2020

Merhaba,

köprü komutunu rölatif bir şekilde hazırlayan bir dialog oluşturmayı planlıyorum
listedeki dosyaları rölatif linkler ile bağlamak istiyorum.

bu şekilde yazan kodum çalışıyor lakin tüm hepsinin kodunu tek tek yazmak istemiyorum.

hücrenin kenarında web sayfalarından alıştığımız üç nokta gibi bir işaret ekleyip, açılan "Application.GetOpenFilename" diyaloğu ile dosyayı seçmek istiyorum.

mevcut kullandığım rölatif link bu şekilde

=KÖPRÜ(".\5XX\0539_CAHİT_ONUR_TRT\0539_CAHİT_ONUR_TRT.xlsm";"0539")

kullanmış olduğum kod statik bir link adresi tanımlıyor.

yardımlarınız için şimdiden teşekkürler ^^

Feyzullah · 1 Eyl 2020

Merhaba,

Çalıştığınız sayfanın sekme adına sağ tıklayın > kod görüntüleye tıklayın > açılan sayfaya aşağıdaki kodu ekleyiniz.

Excel sayfasında köprü ekleyeceğiniz hücreye çift tıklayınız.

VBA:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    FileName = Application.GetOpenFilename(Title:="Köprü oluşturulacak dosyayı seçiniz..")
    If FileName = False Then
        MsgBox "Dosya seçilmedi."
        Exit Sub
    Else
    a = Split(Mid(FileName, InStrRev(FileName, "\") + 1, IIf(InStrRev(FileName, "_") > 0, Len(FileName) - InStrRev(FileName, "\"), 4)), "_")(0)
    Target.FormulaR1C1 = "=HYPERLINK(""" & FileName & """,""" & a & """)"
    Target.Offset(1, 0).Select
    End If
End Sub

Feyzullah · 1 Eyl 2020

Üstte deki mesajımı inceleyiniz. Dosyaları tek tek seçerek değilde toplu olarak seçip işlem yapmak isterseniz aşağıdaki kodu kullanınız.

VBA:

Sub exceldestek()
    FileName = Application.GetOpenFilename(Title:="Köprü oluşturulacak dosyayı seçiniz..", MultiSelect:=True)
    If Not IsArray(FileName) Then
        MsgBox "Dosya seçilmedi."
        Exit Sub
    Else
    Range("A2:A" & Rows.Count).Clear
    For i = LBound(FileName) To UBound(FileName)
    a = Split(Mid(FileName(i), InStrRev(FileName(i), "\") + 1, IIf(InStrRev(FileName(i), "_") > 0, Len(FileName(i)) - InStrRev(FileName(i), "\"), 4)), "_")(0)
        Cells(i + 1, 1).FormulaR1C1 = "=HYPERLINK(""" & FileName(i) & """,""" & a & """)"
    Next i
    End If
End Sub

seckinbilgic · 1 Eyl 2020

Elinize sağlık
Çıkan köprünün adında sadece ilk 4 haneyi yazmasını nasıl belirtebilirim? dosyanın ilk 4 hanesi 0554 gibi bir sayı.

Feyzullah · 1 Eyl 2020

seckinbilgic' Alıntı:
Elinize sağlık
Çıkan köprünün adında sadece ilk 4 haneyi yazmasını nasıl belirtebilirim? dosyanın ilk 4 hanesi 0554 gibi bir sayı.

hangi kodu kullanmaya karar verdiniz.

seckinbilgic · 1 Eyl 2020

Feyzullah' Alıntı:
Merhaba,

Çalıştığınız sayfanın sekme adına sağ tıklayın > kod görüntüleye tıklayın > açılan sayfaya aşağıdaki kodu ekleyiniz.

Excel sayfasında köprü ekleyeceğiniz hücreye çift tıklayınız.

VBA:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) FileName = Application.GetOpenFilename(Title:="Köprü oluşturulacak dosyayı seçiniz..") If FileName = False Then MsgBox "Dosya seçilmedi." Exit Sub Else a = Split(Mid(FileName, InStrRev(FileName, "\") + 1, IIf(InStrRev(FileName, "_") > 0, Len(FileName) - InStrRev(FileName, "\"), 4)), "_")(0) Target.FormulaR1C1 = "=HYPERLINK(""" & FileName & """,""" & a & """)" Target.Offset(1, 0).Select End If End Sub

Bu şekilde kullanacağım

Feyzullah · 1 Eyl 2020

ilgili kodu aşağıdaki gibi değiştirip dener misiniz ?

Kod:

a = Split(Mid(Filename, InStrRev(Filename, "\") + 1, 4), "_")(0)

Feyzullah · 1 Eyl 2020

Feyzullah' Alıntı:
ilgili kodu aşağıdaki gibi değiştirip dener misiniz ?

Kod:

a = Split(Mid(Filename, InStrRev(Filename, "\") + 1, 4), "_")(0)

daha da sadeleştirmek gerekse

Kod:

a = Mid(Filename, InStrRev(Filename, "\") + 1, 4)

seckinbilgic · 1 Eyl 2020

Görüntülenecek metin "5XX\0568_AHMET_DURAN_TRT\0568_AHMET_DURAN_TRT.xlsm"

şeklinde görüntülüyor ne yazık ki.

Hedefim " 0568" ü seçmesi

Feyzullah · 1 Eyl 2020

seckinbilgic' Alıntı:
Görüntülenecek metin "5XX\0568_AHMET_DURAN_TRT\0568_AHMET_DURAN_TRT.xlsm"

şeklinde görüntülüyor ne yazık ki.

Hedefim " 0568" ü seçmesi

Aşağıdaki kodu deneyin bir de hocam.

VBA:

a = Left(Split(Filename, "\")(UBound(Split(Filename, "\"))), 4)

Feyzullah · 1 Eyl 2020

Kodun son halini aşağıdaki gibi, ağ üzerinde de test ettim dediğiniz gibi dosya adının ilk 4 karakterini alıyor.

VBA:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Filename = Application.GetOpenFilename(Title:="Köprü oluşturulacak dosyayı seçiniz..")
    If Filename = False Then
        MsgBox "Dosya seçilmedi."
        Exit Sub
    Else
    a = Left(Split(Filename, "\")(UBound(Split(Filename, "\"))), 4)
    Target.FormulaR1C1 = "=HYPERLINK(""" & Filename & """,""" & a & """)"
    Target.Offset(1, 0).Select
    End If
End Sub

seckinbilgic · 3 Eyl 2020

Feyzullah' Alıntı:

Kodun son halini aşağıdaki gibi, ağ üzerinde de test ettim dediğiniz gibi dosya adının ilk 4 karakterini alıyor.

VBA:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Filename = Application.GetOpenFilename(Title:="Köprü oluşturulacak dosyayı seçiniz..")
    If Filename = False Then
        MsgBox "Dosya seçilmedi."
        Exit Sub
    Else
    a = Left(Split(Filename, "\")(UBound(Split(Filename, "\"))), 4)
    Target.FormulaR1C1 = "=HYPERLINK(""" & Filename & """,""" & a & """)"
    Target.Offset(1, 0).Select
    End If
End Sub

Merhaba.
Köprü çalışıyor. Lakin denemelerimiz sonunda dosyanın tam adını yazmaya devam ediyor.

Feyzullah · 3 Eyl 2020

seckinbilgic' Alıntı:
Merhaba.
Köprü çalışıyor. Lakin denemelerimiz sonunda dosyanın tam adını yazmaya devam ediyor.

kodunuzun son halini paylaşırmısınız yada farklı bir işlem mi var.
Bende sorun çıkmıyor.

Ömer BARAN · 4 Eyl 2020

Merhabalar Sayın @seckinbilgic .

Sayın @Feyzullah 'ın müsadeleriyle.

Sanırım @seckinbilgic , hücrede görünen metinden değil de,
oluşturulan köprü üzerine fareyle gidildiğinde görüntülenen Ekran İpucu olarak görünen metni kastediyor.

Sayın @Feyzullah 'ın verdiği kodu aşağıdaki gibi revize edersek ekran ipucu olarak da 4 karakterlik dosya adı görüntülenmiş olur.

VBA:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Filename = Application.GetOpenFilename(Title:="Köprü oluşturulacak dosyayı seçiniz..")
    If Filename = False Then
        MsgBox "Dosya seçilmedi.": Exit Sub
    Else
        a = Left(Split(Filename, "\")(UBound(Split(Filename, "\"))), 4)
        Target.Hyperlinks.Add Anchor:=Selection, Address:=[B][COLOR=rgb(43, 84, 44)]Filename[/COLOR][/B], [B][COLOR=rgb(132, 53, 52)]ScreenTip:=a[/COLOR][/B], [B][COLOR=rgb(43, 84, 44)]TextToDisplay:=a[/COLOR][/B]
        Cancel = True
    End If
End Sub

.

seckinbilgic · 9 Eyl 2020

Ömer BARAN' Alıntı:
Merhabalar Sayın @seckinbilgic .

Sayın @Feyzullah 'ın müsadeleriyle.

Sanırım @seckinbilgic , hücrede görünen metinden değil de,
oluşturulan köprü üzerine fareyle gidildiğinde görüntülenen Ekran İpucu olarak görünen metni kastediyor.

Sayın @Feyzullah 'ın verdiği kodu aşağıdaki gibi revize edersek ekran ipucu olarak da 4 karakterlik dosya adı görüntülenmiş olur.

VBA:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Filename = Application.GetOpenFilename(Title:="Köprü oluşturulacak dosyayı seçiniz..") If Filename = False Then MsgBox "Dosya seçilmedi.": Exit Sub Else a = Left(Split(Filename, "\")(UBound(Split(Filename, "\"))), 4) Target.Hyperlinks.Add Anchor:=Selection, Address:=[B][COLOR=rgb(43, 84, 44)]Filename[/COLOR][/B], [B][COLOR=rgb(132, 53, 52)]ScreenTip:=a[/COLOR][/B], [B][COLOR=rgb(43, 84, 44)]TextToDisplay:=a[/COLOR][/B] Cancel = True End If End Sub

Merhabalar,

İçeriğe yazdığımız veri çok güzel şekilde çalışıyor.

Görünen metnin kısa bir yazı olmasını istiyorum. Yeni kod ile de bir şekilde olmadı.

Ömer BARAN · 10 Eyl 2020

seckinbilgic' Alıntı:
Merhabalar,

İçeriğe yazdığımız veri çok güzel şekilde çalışıyor.
............Yeni kod ile de bir şekilde olmadı.

Sayın @seckinbilgic .
Cevabınız bana biraz çelişkili geldi (çalışıyor...olmadı) ve sonucu tam anlayamadım.
İstenilen sonuç alındı mı alınmadı mı?

Alınmadı ise en azından foruma bir ekran görüntüsü ekleyin de gerçekleşen durumun ne olduğu daha iyi anlaşılabilsin.

seckinbilgic · 7 Eki 2020

Merhaba tekrardan

deneme yaptığım bazı bilgisayarlarda köprü sorunsuz çalıştı.

Hücrede link görünümünde şu şekilde metin yazıyor.
"5XX\0558_NURAY_KABACALI\0558_NURAY_KABACALI.xlsm"

lakin bazılarında ise köprü dosyası çalışmıyor ve şöyle bir uyarı veriyor
açmaya çalıştığınız sayfa güvensiz olabilir
"About:blank"

Dosya örneğini internet kısıtlı olduğu için ilk fırsatta göndereceğim.

seckinbilgic · 26 Eki 2020

seckinbilgic' Alıntı:
Merhaba tekrardan

deneme yaptığım bazı bilgisayarlarda köprü sorunsuz çalıştı.

Hücrede link görünümünde şu şekilde metin yazıyor.
"5XX\0558_NURAY_KABACALI\0558_NURAY_KABACALI.xlsm"

lakin bazılarında ise köprü dosyası çalışmıyor ve şöyle bir uyarı veriyor
açmaya çalıştığınız sayfa güvensiz olabilir
"About:blank"

Dosya örneğini internet kısıtlı olduğu için ilk fırsatta göndereceğim.

Bazı dosyaların sahip olduğu linkler nasıl olmuşsa sıfırlanmış.

tekrardan tanımladığımda çalışıyor.
nedeni ne olabilir?

seckinbilgic · 26 Eki 2020

2020-10-26 11_46_21-Dozimetri - Excel.webp

köprü adresi about:blank olmuş. kendi kendine.

seckinbilgic · 8 Kas 2020

Önerisi olan?

	Hücrenin Üstüne Geldiğinde Açıklamada Fotoğrafı Gösterme esrarengiz 10 Şub 2024 Makro Soruları
	Hücre Aktarma Sorunu mcexrem 20 Şub 2020 Makro Soruları
	Klasörden Resim Getir / Boyutlandır - Hücreye Sığdır ridvansahin 5 Ara 2019 Makro Soruları
	Formül Olmayan Hücreleri Renklendirme PriveT 12 Şub 2024 Makro Soruları
	Hücredeki Değere Göre Sayfalar Oluşturma Feyzullah 10 Eyl 2024 Makro Soruları