Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Köprü Makro Halinde Yazmak

cdenktas
cdenktas
Excel Soruları ve Cevapları
7
123

Köprü Makro Halinde Yazmak

#1
cdenktas
Aktif Üye
cdenktas
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 45
Konum: -
Ofis Versiyonu: -
Son Oturumu: Bugün,11:20
Yorumları: 175
Konuları: 42
Kayıt Tarihi: 19/09/2019
Teşekkür Puanı: 0
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.
.rar Kasko_Trafik.rar (Dosya Boyutu: 355,9 KB | İndirme Sayısı: 5)
Cevapla
#2
boolean_
Uzman
boolean_
www Bul
Uzman
Adı Soyadı: Er.... Er....
Konum: İstanbul
Ofis Versiyonu: Diğer
Son Oturumu: Bugün,09:42
Yorumları: 551
Konuları: 4
Kayıt Tarihi: 31/10/2008
Teşekkür Puanı: 184
Mesleğiniz: Graphic and Art
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
Cevapla
#3
cdenktas
Aktif Üye
cdenktas
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 45
Konum: -
Ofis Versiyonu: -
Son Oturumu: Bugün,11:20
Yorumları: 175
Konuları: 42
Kayıt Tarihi: 19/09/2019
Teşekkür Puanı: 0
(Dün, 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...
.rar Desktop.rar (Dosya Boyutu: 260,2 KB | İndirme Sayısı: 1)
Cevapla
#4
boolean_
Uzman
boolean_
www Bul
Uzman
Adı Soyadı: Er.... Er....
Konum: İstanbul
Ofis Versiyonu: Diğer
Son Oturumu: Bugün,09:42
Yorumları: 551
Konuları: 4
Kayıt Tarihi: 31/10/2008
Teşekkür Puanı: 184
Mesleğiniz: Graphic and Art
link işlemini yapmanıza gerek yok dosya adlarını yazdıktan sonra kodu çalıştırın linkler otomatik oluşacak.
Cevapla
#5
cdenktas
Aktif Üye
cdenktas
Bul
Aktif Üye
Adı Soyadı:
Yaşı: 45
Konum: -
Ofis Versiyonu: -
Son Oturumu: Bugün,11:20
Yorumları: 175
Konuları: 42
Kayıt Tarihi: 19/09/2019
Teşekkür Puanı: 0
(Dün, 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.
Cevapla
#6
boolean_
Uzman
boolean_
www Bul
Uzman
Adı Soyadı: Er.... Er....
Konum: İstanbul
Ofis Versiyonu: Diğer
Son Oturumu: Bugün,09:42
Yorumları: 551
Konuları: 4
Kayıt Tarihi: 31/10/2008
Teşekkür Puanı: 184
Mesleğiniz: Graphic and Art
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
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task