Ayrı sayfalardan PDF oluşturma Makrosu

[SSAFFAK]

Değerli Hocalarım Merhabalar; Benim şöyle bir yardıma ihtiyacım var. "1.OCAK - ŞUBAT" Adlı dosyamda "LİSTE", "MESAİ FİŞİ", "Kapak", "Gece Nöbet Sayıları", "Fazla Mesai" isimli 5 ayrı sheet (sayfam) var. Benim yapmak istediğim Liste sayfasına buton yardımıyla LİSTE A1:AN40, MESAİ FİŞİ B2:K637, Kapak B2:K50, Gece Nöbet Sayıları B2:S46, Fazla Mesai B2:S47 arasını , sayfaları ayrı ayrı PDF e dönüştürüp, Desktop üstüne "LİSTE sayfası C3" hücresindeki İsimle klasör açarak, "1.OCAK - ŞUBAT"dosya isminde PDF olarak ayrı ayrı içine yapıştırsın istiyorum. Makro konusunda Yardımcı olabilirmisiniz acaba..

 

[muhasebeciyiz]

Sub ExcelToPDF()

Dim ws As Worksheet
Dim rng As Range
Dim folderPath As String
Dim mainFolderName As String
Dim subFolderName As String
Dim fileName As String

mainFolderName = ThisWorkbook.Sheets("LİSTE").Range("C3").Value
subFolderName = ThisWorkbook.Sheets("LİSTE").Range("C2").Value
folderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & mainFolderName
folderPath = folderPath & "\" & subFolderName

If Dir(folderPath, vbDirectory) = "" Then
MkDir folderPath
End If

fileName = "1.OCAK - ŞUBAT"

For Each ws In ThisWorkbook.Worksheets
Set rng = Nothing
If ws.Name = "LİSTE" Then

Set rng = ws.Range("A1:AN40")
ElseIf ws.Name = "MESAİ FİŞİ" Then
Set rng = ws.Range("B2:K637")
ElseIf ws.Name = "Kapak" Then
Set rng = ws.Range("B2:K50")
ElseIf ws.Name = "Gece Nöbet Sayıları" Then
Set rng = ws.Range("B2:S46")
ElseIf ws.Name = "Fazla Mesai" Then
Set rng = ws.Range("B2:S47")
End If

If Not rng Is Nothing Then

ws.ExportAsFixedFormat Type:=xlTypePDF, _
fileName:=folderPath & "\" & fileName & "_" & ws.Name & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
Next ws

End Sub

Bu kodları KOD sayfasına sağ tıklayıp makro görüntüle dedikten sonra karşınıza gelen pencereye kopyalayın çalıştırın ve sonucu görünüz

 

[SSAFFAK]

Hocam çok özür dileyerek bir düzeltme rica etsem; Klasör açma durumu konusunda; ilk açtığı klasör adını LİSTE C3 ten alıyor, fakat bu klasör içine adını LİSTE C2 den alan 2.ci bir yeni bir klasör açması ve onun içine sadece sheet adlarını içeren pdf leri koymasını sağlayabilirmiyiz acaba? Çünkü LİSTE C3 Yılı içeriyor. Örnek o yıl içine Ocak-Şubat, Şubat-Mart, Mart-Nisan gibi diğer ayları da eklemem gerekiyor. Kusura bakma hocam zahmet ettim size..

 

[BaY_KaPTaN]

Hocam çok özür dileyerek bir düzeltme rica etsem; Klasör açma durumu konusunda; ilk açtığı klasör adını LİSTE C3 ten alıyor, fakat bu klasör içine adını LİSTE C2 den alan 2.ci bir yeni bir klasör açması ve onun içine sadece sheet adlarını içeren pdf leri koymasını sağlayabilirmiyiz acaba? Çünkü LİSTE C3 Yılı içeriyor. Örnek o yıl içine Ocak-Şubat, Şubat-Mart, Mart-Nisan gibi diğer ayları da eklemem gerekiyor. Kusura bakma hocam zahmet ettim size..

@muhasebeciyiz hocamın ellerine sağlık.
Gayet güzel kod olmuş.

@SSAFFAK hocam,
Son isteğinize göre aşağıdaki kod işinizi görür sanırım.
Eklenen kod kırmızıyla işaretlenmiştir.

folderName = ThisWorkbook.Sheets("Liste").Range("C3").Value & "\" & Range("C2").Value
ve
fileName = Range("C2").Value

Sub ExcelToPDF()

Dim ws As Worksheet
Dim rng As Range
Dim folderPath As String
Dim folderName As String
Dim fileName As String

folderName = ThisWorkbook.Sheets("Liste").Range("C3").Value & "\" & Range("C2").Value

folderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & folderName

If Dir(folderPath, vbDirectory) = "" Then
MkDir folderPath
End If

fileName = Range("C2").Value

For Each ws In ThisWorkbook.Worksheets
Set rng = Nothing
If ws.Name = "LİSTE" Then
Set rng = ws.Range("A1:AN40")
ElseIf ws.Name = "MESAİ FİŞİ" Then
Set rng = ws.Range("B2:K637")
ElseIf ws.Name = "Kapak" Then
Set rng = ws.Range("B2:K50")
ElseIf ws.Name = "Gece Nöbet Sayıları" Then
Set rng = ws.Range("B2:S46")
ElseIf ws.Name = "Fazla Mesai" Then
Set rng = ws.Range("B2:S47")
End If

If Not rng Is Nothing Then

ws.ExportAsFixedFormat Type:=xlTypePDF, _
fileName:=folderPath & "\" & fileName & "_" & ws.Name & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
Next ws

End Sub

 

[muhasebeciyiz]

Düzenledim.Denermisiniz.Bazen klasörü oluşturamıyor.Siz 2024 olarak klasör açarsanız düzgün çalışıyor.Sorun yoksa devam.

 

[SSAFFAK]

Kürşat Hocam ve Muhasebeciyiz hocam ellerinize Sağlık. Allah Razı olsun.
Kürşat Hocam sizin Makroyla 2.Klasörü yani C2="ocak-şubat" açmadan C3= "2024" isimli klasör açıp içine pdf ekliyor.
Muhasebeci Hocam size de çok minnettarım dediğiniz gibi dekstop' a 2024 isimli dosya açdığımda istediğim şekilde içine ocak-şubat klasörü açıp onun içine ekledi. Hepinize çok çok teşekkür ederim. Varolun.