Değerli arkadaşlar;
Kasko_Trafik
Excel çalışmasında B (Kasko pdf sini) ve C (Trafik sigortasın pdf) sütunları bastığımızda pdf. getiren bir makro ihtiyacım var. Köprü yapabiliyorum ancak flash bellek ile başka bir bilgisayara taşıdığımda yolu görmediğinden pdf açılmıyor. Bu konuda yardımcı olursanız sevinirim.
Merhabalar,
Klasör içerisendeki dosyalara link işlemini aşağıdaki kod ile yapabilirsiniz.
Kod:
Sub Link_Ekle()
Dim lastRow As Long
Dim fileName As String
Dim folderPath1 As String
Dim folderPath2 As String
Dim ws As Worksheet
Dim i As Long
Dim workbookPath As String
Set ws = ThisWorkbook.Sheets(1)
workbookPath = ThisWorkbook.Path
folderPath1 = workbookPath & "\Kasko\"
folderPath2 = workbookPath & "\Trafik\"
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
fileName = ws.Cells(i, 1).Value
If Dir(folderPath1 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 2), Address:=folderPath1 & fileName & ".pdf", TextToDisplay:="Kasko PDF"
Else
ws.Cells(i, 2).Value = "Dosya yok"
End If
If Dir(folderPath2 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 3), Address:=folderPath2 & fileName & ".pdf", TextToDisplay:="Trafik PDF"
Else
ws.Cells(i, 3).Value = "Dosya yok"
End If
Next i
End Sub
(17/10/2024, 12:12)boolean_ yazdı: Merhabalar,
Klasör içerisendeki dosyalara link işlemini aşağıdaki kod ile yapabilirsiniz.
Kod:
Sub Link_Ekle()
Dim lastRow As Long
Dim fileName As String
Dim folderPath1 As String
Dim folderPath2 As String
Dim ws As Worksheet
Dim i As Long
Dim workbookPath As String
Set ws = ThisWorkbook.Sheets(1)
workbookPath = ThisWorkbook.Path
folderPath1 = workbookPath & "\Kasko\"
folderPath2 = workbookPath & "\Trafik\"
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
fileName = ws.Cells(i, 1).Value
If Dir(folderPath1 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 2), Address:=folderPath1 & fileName & ".pdf", TextToDisplay:="Kasko PDF"
Else
ws.Cells(i, 2).Value = "Dosya yok"
End If
If Dir(folderPath2 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 3), Address:=folderPath2 & fileName & ".pdf", TextToDisplay:="Trafik PDF"
Else
ws.Cells(i, 3).Value = "Dosya yok"
End If
Next i
End Sub
Ellerinze sağlık, ancak link işlemini köprü yaparak mı oluşturacağım...
link işlemini yapmanıza gerek yok dosya adlarını yazdıktan sonra kodu çalıştırın linkler otomatik oluşacak.
(17/10/2024, 14:43)boolean_ yazdı: link işlemini yapmanıza gerek yok dosya adlarını yazdıktan sonra kodu çalıştırın linkler otomatik oluşacak.
Merhabalar;
Değinizi yaptım, çalışıyor. Ellerinize sağlık. Ancak;
lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
Benim plakalar F sütunda ve "Kasko" ve "Trafik" boş olan sütunlar G ve H yer almakta böyle çalıştırdığımda veriler gelmiyor ancak ben plakalara A sutüna taşıdığımda B ve C sutünları aktif oluyor. Ne yapmam gerekir.
Merhabalar,
ilgili düzenlemeyi yaptım. Koddan değişen yerleri görebilirsiniz.
Kod:
Sub Link_Ekle()
Dim lastRow As Long
Dim fileName As String
Dim folderPath1 As String
Dim folderPath2 As String
Dim ws As Worksheet
Dim i As Long
Dim workbookPath As String
Set ws = ThisWorkbook.Sheets(1)
workbookPath = ThisWorkbook.Path
folderPath1 = workbookPath & "\Kasko\"
folderPath2 = workbookPath & "\Trafik\"
lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
For i = 2 To lastRow
fileName = ws.Cells(i, 6).Value
If Dir(folderPath1 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 7), Address:=folderPath1 & fileName & ".pdf", TextToDisplay:="Kasko PDF"
Else
ws.Cells(i, 7).Value = "Dosya yok"
End If
If Dir(folderPath2 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 8), Address:=folderPath2 & fileName & ".pdf", TextToDisplay:="Trafik PDF"
Else
ws.Cells(i, 8).Value = "Dosya yok"
End If
Next i
End Sub