Yerine koy ve PDF oluştur.

[muratgunay48]

Arkadaşlar sayın hocalarım, bir dosya yapmaya çalıştım. Döngü kurdum ama sonrası olmadı.
Sayfa1'de A sütununda isimler var.
Sayfa2'de yazılacak metin var.
Metin aynı olacak hep.
Sayfa1 A1 hücresindeki ismi Sayfa2 C1'e koyacak ve Sayfa1 A1 hücresindeki isim adıyla C:\Users\muratgunay48\Documents\yazılar adlı klasöre PDF olarak kaydedecek.
Sayfa1 A2 hücresindeki ismi Sayfa2 C1'e koyacak ve Sayfa1 A2 hücresindeki isim adıyla C:\Users\muratgunay48\Documents\yazılar adlı klasöre PDF olarak kaydedecek.
Sayfa1 A3 hücresindeki ismi Sayfa2 C1'e koyacak ve Sayfa1 A3 hücresindeki isim adıyla C:\Users\muratgunay48\Documents\yazılar adlı klasöre PDF olarak kaydedecek.
.
.
.
.
Böyle gidecek.
Yardımlarınız için şimdiden teşekkür ederim.
Saygılarımla.

 

[Hakan ERDOST]

Arkadaşlar sayın hocalarım, bir dosya yapmaya çalıştım. Döngü kurdum ama sonrası olmadı.
Sayfa1'de A sütununda isimler var.
Sayfa2'de yazılacak metin var.
Metin aynı olacak hep.
Sayfa1 A1 hücresindeki ismi Sayfa2 C1'e koyacak ve Sayfa1 A1 hücresindeki isim adıyla C:\Users\muratgunay48\Documents\yazılar adlı klasöre PDF olarak kaydedecek.
Sayfa1 A2 hücresindeki ismi Sayfa2 C1'e koyacak ve Sayfa1 A2 hücresindeki isim adıyla C:\Users\muratgunay48\Documents\yazılar adlı klasöre PDF olarak kaydedecek.
Sayfa1 A3 hücresindeki ismi Sayfa2 C1'e koyacak ve Sayfa1 A3 hücresindeki isim adıyla C:\Users\muratgunay48\Documents\yazılar adlı klasöre PDF olarak kaydedecek.
.
.
.
.
Böyle gidecek.
Yardımlarınız için şimdiden teşekkür ederim.
Saygılarımla.

Sub IsmeGorePDFKaydet()
    Dim wsKaynak As Worksheet
    Dim wsHedef As Worksheet
    Dim sonSatir As Long
    Dim i As Long
    Dim isim As String
    Dim klasorYolu As String
    Dim dosyaAdi As String
   
    ' Sayfaları tanımla
    Set wsKaynak = ThisWorkbook.Sheets("Sayfa1") ' İsimlerin olduğu sayfa
    Set wsHedef = ThisWorkbook.Sheets("Sayfa2") ' Metnin olduğu ve C1'in değişeceği sayfa

    ' Kayıt yapılacak klasör
    klasorYolu = "C:\Users\muratgunay48\Documents\yazılar\"
   
    ' Eğer klasör yoksa, oluştur
    If Dir(klasorYolu, vbDirectory) = "" Then
        MkDir klasorYolu
    End If
   
    ' Son dolu satırı bul
    sonSatir = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row
   
    ' A1'den son satıra kadar dön
    For i = 1 To sonSatir
        isim = wsKaynak.Cells(i, 1).Value
       
        If isim <> "" Then
            ' İsmi Sayfa2 C1 hücresine yaz
            wsHedef.Range("C1").Value = isim
           
            ' Dosya adını hazırla
            dosyaAdi =  isim & ".pdf"
           
            ' Sayfa2'yi PDF olarak kaydet
            wsHedef.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dosyaAdi, Quality:=xlQualityStandard
        End If
    Next i
   
    MsgBox "Tüm PDF dosyaları başarıyla kaydedildi!", vbInformation
End Sub

Sayfaya bir düğme ekleyerek, düğme ile kodu ilişkilendirip, deneyiniz.

 

[muratgunay48]

Sub IsmeGorePDFKaydet()
    Dim wsKaynak As Worksheet
    Dim wsHedef As Worksheet
    Dim sonSatir As Long
    Dim i As Long
    Dim isim As String
    Dim klasorYolu As String
    Dim dosyaAdi As String
  
    ' Sayfaları tanımla
    Set wsKaynak = ThisWorkbook.Sheets("Sayfa1") ' İsimlerin olduğu sayfa
    Set wsHedef = ThisWorkbook.Sheets("Sayfa2") ' Metnin olduğu ve C1'in değişeceği sayfa

    ' Kayıt yapılacak klasör
    klasorYolu = "C:\Users\muratgunay48\Documents\yazılar\"
  
    ' Eğer klasör yoksa, oluştur
    If Dir(klasorYolu, vbDirectory) = "" Then
        MkDir klasorYolu
    End If
  
    ' Son dolu satırı bul
    sonSatir = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row
  
    ' A1'den son satıra kadar dön
    For i = 1 To sonSatir
        isim = wsKaynak.Cells(i, 1).Value
      
        If isim <> "" Then
            ' İsmi Sayfa2 C1 hücresine yaz
            wsHedef.Range("C1").Value = isim
          
            ' Dosya adını hazırla
            dosyaAdi =  isim & ".pdf"
          
            ' Sayfa2'yi PDF olarak kaydet
            wsHedef.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dosyaAdi, Quality:=xlQualityStandard
        End If
    Next i
  
    MsgBox "Tüm PDF dosyaları başarıyla kaydedildi!", vbInformation
End Sub

Sayfaya bir düğme ekleyerek, düğme ile kodu ilişkilendirip, deneyiniz.

Hocam emeğinize sağlık, tam istediğim gibi. Yalnız ilginçtir. Belgelerimdeki dosyaya değil de direk belgelerime kaydediyor. Dosya ismini değiştirdim (VBA'dan da tabi). Yok olmuyor.

 

[mustafa1205]

Sub IsmeGorePDFKaydet()
Dim wsKaynak As Worksheet
Dim wsHedef As Worksheet
Dim sonSatir As Long
Dim i As Long
Dim isim As String
Dim klasorYolu As String
Dim dosyaAdi As String

' Sayfaları tanımla
Set wsKaynak = ThisWorkbook.Sheets("Sayfa1") ' İsimlerin olduğu sayfa
Set wsHedef = ThisWorkbook.Sheets("Sayfa2") ' Metnin olduğu ve C1'in değişeceği sayfa

' Kayıt yapılacak klasör yolu
klasorYolu = "C:\Users\muratgunay48\Documents\yazılar\"

' Eğer klasör yoksa oluştur
If Dir(klasorYolu, vbDirectory) = "" Then
MkDir klasorYolu
End If

' Son dolu satırı bul
sonSatir = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row

' A1'den son satıra kadar döngü
For i = 1 To sonSatir
isim = Trim(wsKaynak.Cells(i, 1).Value)

If isim <> "" Then
' İsmi Sayfa2 C1 hücresine yaz
wsHedef.Range("C1").Value = isim

' Dosya adını ve yolu hazırla
dosyaAdi = klasorYolu & isim & ".pdf"

' Sayfa2'yi PDF olarak kaydet
wsHedef.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dosyaAdi, Quality:=xlQualityStandard
End If
Next i

MsgBox "Tüm PDF dosyaları başarıyla 'yazılar' klasörüne kaydedildi!", vbInformation
End Sub



bu şekilde bir dener misiniz ?

 

[muratgunay48]

Sub IsmeGorePDFKaydet()
Dim wsKaynak As Worksheet
Dim wsHedef As Worksheet
Dim sonSatir As Long
Dim i As Long
Dim isim As String
Dim klasorYolu As String
Dim dosyaAdi As String

' Sayfaları tanımla
Set wsKaynak = ThisWorkbook.Sheets("Sayfa1") ' İsimlerin olduğu sayfa
Set wsHedef = ThisWorkbook.Sheets("Sayfa2") ' Metnin olduğu ve C1'in değişeceği sayfa

' Kayıt yapılacak klasör yolu
klasorYolu = "C:\Users\muratgunay48\Documents\yazılar\"

' Eğer klasör yoksa oluştur
If Dir(klasorYolu, vbDirectory) = "" Then
MkDir klasorYolu
End If

' Son dolu satırı bul
sonSatir = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row

' A1'den son satıra kadar döngü
For i = 1 To sonSatir
isim = Trim(wsKaynak.Cells(i, 1).Value)

If isim <> "" Then
' İsmi Sayfa2 C1 hücresine yaz
wsHedef.Range("C1").Value = isim

' Dosya adını ve yolu hazırla
dosyaAdi = klasorYolu & isim & ".pdf"

' Sayfa2'yi PDF olarak kaydet
wsHedef.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dosyaAdi, Quality:=xlQualityStandard
End If
Next i

MsgBox "Tüm PDF dosyaları başarıyla 'yazılar' klasörüne kaydedildi!", vbInformation
End Sub



bu şekilde bir dener misiniz ?

Hocam çok teşekkür ederim. Emeğinize sağlık. Var olun.

 

[mustafa1205]

Kolay gelsin İyi Çalışmalar Dilerim. Umarım İstediğiniz gibi olmuştur. Hakan Beyin emeğine sağlık. Asıl kodu yazan O. Ben sadece bir iki düzeltme yaptım..