Otomatik Pdf yapma

[bjk55]

Merhaba Mutabık sayfasında Bulunan liste de ayrı ayrı firmalar var ama 28 - 35 ci (sarı) satırlar hep sabit sadece üstte filtrelediğim firmaları ben ayrı ayrı filtreden seçerek hepsini örnekteki gibi pdf yapmaktayım. Bunun için makro ile listede bulunan bütün firmalara ayrı ayrı bir butona tıkladığım zaman otomatik pdf nasıl yapabilirim. Birde Liste çok uzun sa dikey olarak liste kısaysa yatay olarak pdf yapmak istiyorum.Dosya ektedir.

 

[bjk55]

Tekrar Merhaba, bu konuyla ilgili nasıl birşey yapabilirim. Yardım ederseniz sevinirim. İyi Akşamlar

 

[bjk55]

Merhaba Mutabık sayfasında Bulunan liste de ayrı ayrı firmalar var ama 28 - 35 ci (sarı) satırlar hep sabit sadece üstte filtrelediğim firmaları ben ayrı ayrı filtreden seçerek hepsini örnekteki gibi pdf yapmaktayım. Bunun için makro ile listede bulunan bütün firmalara ayrı ayrı bir butona tıkladığım zaman otomatik pdf nasıl yapabilirim. Birde Liste çok uzun sa dikey olarak liste kısaysa yatay olarak pdf yapmak istiyorum.Dosya ektedir.

Bilen birisi varmıdır acaba

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Mutabakat_Mektubu()
    Dim S1 As Worksheet, Musteri_Listesi As Object, Musteri As Variant, X As Long
    
    Application.ScreenUpdating = False
    
    Set Musteri_Listesi = VBA.CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("MUTABIK")
    
    On Error Resume Next
    If S1.AutoFilterMode Then S1.ShowAllData
    On Error GoTo 0
    
    For X = 2 To S1.Cells(S1.Rows.Count, "O").End(3).Row
        If Not Musteri_Listesi.Exists(S1.Cells(X, "B").Value) Then
            Musteri_Listesi.Add S1.Cells(X, "B").Value, False
        End If
    Next
    
    For Each Musteri In Musteri_Listesi.Keys
        S1.Range("A1:O" & S1.Cells(S1.Rows.Count, "O").End(3).Row).AutoFilter 2, Musteri
        If S1.Cells(S1.Rows.Count, "O").End(3).Row > 30 Then
            S1.PageSetup.Orientation = xlPortrait
        Else
            S1.PageSetup.Orientation = xlLandscape
        End If
        S1.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "\" & Musteri & " - Mutabakat Mektubu.pdf", _
        OpenAfterPublish:=False
    Next
    
    On Error Resume Next
    If S1.AutoFilterMode Then S1.ShowAllData
    On Error GoTo 0
    
    Set Musteri_Listesi = Nothing
    Set S1 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Mutabakat mektupları oluşturulmuştur.", vbInformation
End Sub

 

[bjk55]

Korhan Bey çok çok teşekkür ederim, yalnız şu aşağıda ki kodlamaya "R1" sütünunu eklemek istiyorum

Filename:=ThisWorkbook.Path & "\" & Musteri & " - Mutabakat Mektubu.pdf",

 

[Korhan Ayhan]

Kendiniz uygun yere yazarsınız..

Filename:=ThisWorkbook.Path & "\" & Musteri & " " & S1.Range("R1").Value & " - Mutabakat Mektubu.pdf",

 

[bjk55]

Kendiniz uygun yere yazarsınız..

Filename:=ThisWorkbook.Path & "\" & Musteri & " " & S1.Range("R1").Value & " - Mutabakat Mektubu.pdf",

Çok teşekkür ederim ama
S1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & Musteri & " " & S1.Range("R1").Value & " - Mutabakat Mektubu.pdf",
OpenAfterPublish:=False

bu şekilde girdiğim zaman hata verdi

 

[Korhan Ayhan]

Bahsi geçen hücrede ne yazıyor?

Bildiğiniz üzere dosya isimlerinde kullanılmaması gereken karakterler var. İlgili hücrede yasaklı olan bir karakter varsa hata vermesi normaldir. Bunu düzenlemeniz gerekir.