Skip to main content

AccessTr.neT


Köprü Makro Halinde Yazmak

Köprü Makro Halinde Yazmak

#7
(18/10/2024, 09:42)boolean_ yazdı: 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


Günaydın Hocam;

Yapmış olduğunuz kod yükledim. Bu sefer dosya bulunamıyor mesajı verdi .Resim olarak yüklemek istedim ancak kurum engelleme yaptığından yükleyemedim. Acaba nerede hata yapıyorum...
.rar Hata1.rar (Dosya Boyutu: 12,31 KB | İndirme Sayısı: 1)
Cevapla
#8
(18/10/2024, 10:32)cdenktas yazdı:
(18/10/2024, 09:42)boolean_ yazdı: 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


Günaydın Hocam;

Yapmış olduğunuz kod yükledim. Bu sefer dosya bulunamıyor mesajı verdi .Resim olarak yüklemek istedim ancak kurum engelleme yaptığından yükleyemedim. Acaba nerede hata yapıyorum...


Makro içeren Excel Kasko_Trafik klasörün dışındaydı, onun içerisine taşıdığımda çalıştı. Ellerinize sağlık...
Cevapla
#9
Sizin de belirttiğiniz üzere diğer bilgisayarlarda da çalışabilmesi için Excel ile klasörlerin aynı yerde olması lazım.
Size yardımcı olmabildiğimize sevindim.
iyi günler dilerim.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task