Macro ile köprü yazdırmak

[mersilen]

Merhabalar

Macro ile hücreye köprü yazdırmak istiyorum,
yardımlarınız için teşekkürler

formülü

=KÖPRÜ("kor\" & D39 & ".html";C39)

Macro ??

Cells(Target.Row, 5) = "=HYPERLINK(" & """ \ kor \ """ & Cells(Target.Row, 4) & "," & Cells(Target.Row, 3) & ")"

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Cells(Target.Row, 5) = "=HYPERLINK(" & """\kor\""" & "&D" & Target.Row & "&" & """.html""" & ",C" & Target.Row & ")"

.

 

[mersilen]

Ömer bey çok teşekkürler, kod doğru çalışıyor

Size zahmet olmazsa,
aşağıdaki koddaki desktop kayıt yerini excel dosyasının bulunduğu dizine (daha doğrusu dizini\kor\) olarak yapmamız mümkün mü?

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, [C20:C2000,w20:w2000]) Is Nothing Then GoTo Adım2:
Cells(Target.Row, 27) = 1

Adım2:
If Intersect(Target, [cr20:cr2000]) Is Nothing Then Exit Sub
Dim klasor, dosyaadi, i, a, b, c, d, e
klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = Worksheets("Sayfa1").Cells(Target.Row, 4)


Worksheets("Txt Dosyası").Cells(35, 1) = "<input type=" & """hidden""" & " name=" & """galaxy""" & " value=" & """" & Mid(Cells(Target.Row, 3).Value, 1, 2) & """" & ">"
Worksheets("Txt Dosyası").Cells(36, 1) = "<input type=" & """hidden""" & " name=" & """system""" & " value=" & """" & Mid(Cells(Target.Row, 3).Value, 4, 3) & """" & ">"
Worksheets("Txt Dosyası").Cells(37, 1) = "<input type=" & """hidden""" & " name=" & """orbit""" & " value=" & """" & Mid(Cells(Target.Row, 3).Value, 8, 2) & """" & ">"

Worksheets("Txt Dosyası").Cells(42, 1) = "<input type=" & """hidden""" & " name=" & """schiff[2]""" & " value=" & """" & Worksheets("Sayfa1").Cells(Target.Row, 96).Value & """" & ">"
Worksheets("Txt Dosyası").Cells(43, 1) = "<input type=" & """hidden""" & " name=" & """schiff[14]""" & " value=" & """" & Worksheets("Sayfa1").Cells(Target.Row, 95).Value & """" & ">"
Worksheets("Txt Dosyası").Cells(49, 1) = Worksheets("Sayfa1").Cells(Target.Row, 3).Value & " - Gezegen"

    
If dosyaadi = "" Then
MsgBox "Dosya adı boş olamaz"
Exit Sub
End If
Open klasor & "\" & dosyaadi & ".html" For Output As #1
For i = 1 To Worksheets("Txt Dosyası").Cells(Rows.Count, "a").End(3).Row
a = Worksheets("Txt Dosyası").Cells(i, 1).Value & " "
b = Worksheets("Txt Dosyası").Cells(i, 2).Value & " "
c = Worksheets("Txt Dosyası").Cells(i, 3).Value & " "
d = Worksheets("Txt Dosyası").Cells(i, 4).Value & " "
e = Worksheets("Txt Dosyası").Cells(i, 5).Value
Print #1, a & b & c & d & e
Next i
Cells(Target.Row, "cr").Interior.ColorIndex = 4
Cells(Target.Row, 5) = "=HYPERLINK(" & """\kor\""" & "&D" & Target.Row & "&" & """.html""" & ",C" & Target.Row & ")"

MsgBox dosyaadi & "  Dosyası masa üstüne kayıt edildi"
Close #1

End Sub

 

[Ömer]

klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")

bölümü yerine;

klasor = ThisWorkbook.Path

yazarak deneyin.

.

 

[mersilen]

Ömer bey tekrar teşekkürler

 

[MAJORTOUR]

Sayın Mersilen, Ömer beyle check ettiğiniz kod eğer çalışma sayfası değilde workbook da geçerli oluyormu? Yani tüm çalışma sayfalarına ( 100 tane çalışma sayfasındaki hücrelere köprü bağlanacaksa).. Mersi