PDF Dosyalarını Birleştirme
23 Temmuz 2021
1742
PDF Dosyalarını Birleştirme isimli kod, farklı farklı isimlerde kaydedilmiş pdf dosyalarını Excel üzerinden birleştirme işlevini görmektedir.
Sub Main()
Dim MyFiles As String, DestFile As String
With ActiveSheet
MyFiles = .Range("A1").Value & "," & .Range("B1").Value
DestFile = .Range("C1").Value
End With
Call MergePDFs01(MyFiles, DestFile)
End Sub
Sub MergePDFs01(MyFiles As String, DestFile As String)
Dim a As Variant, i As Long, n As Long, ni As Long
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.AcroPDDoc
a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))
On Error GoTo exit_
If Len(Dir(DestFile)) Then Kill DestFile
For i = 0 To UBound(a)
If Dir(Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
Exit For
End If
Set PartDocs(i) = New Acrobat.AcroPDDoc
PartDocs(i).Open Trim(a(i))
If i Then
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Cannot insert pages of" & vbLf & a(i), vbExclamation, "Canceled"
End If
n = n + ni
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
n = PartDocs(0).GetNumPages()
End If
Next
If i > UBound(a) Then
If Not PartDocs(0).Save(PDSaveFull, DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled"
End If
End If
exit_:
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
MsgBox "The resulting file is created:" & vbLf & DestFile, vbInformation, "Done"
End If
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing
AcroApp.Exit
Set AcroApp = Nothing
End SubGerekli Adımlar
Kodu çalıştırmanız için aşağıdaki adımları yerine getirmeniz gerekir.
- Microsoft Visual Basic for Applications penceresini (Alt + F11) açın.
- Project - VBAProject alanının, ekranın sol tarafında görüldüğünden emin olun. Görünmüyorsa, Ctrl + R kısayolu ile hızlıca açın.
- Araç çubuklarından Insert -> Module yazısına tıklayın.
- Solunda klasör simgesi olan Modules yazısının başındaki + simgesine tıklayın.
- Alt kısma eklenecek gelecek olan Module(1) yazısına çift tıklayın.
- Üstteki kodu yapıştırın.
Kod Açıklaması
Üst resimdeki gibi alanları kendinize göre doldurup, örnek kodları çalıştırabilirsiniz.
Hazır Dosyayı İndir
Dosyayı indirmek için giriş yapmanız ve VIP Üyelik Paketine sahip olmanız gerekir.
| YARARLI KISAYOLLAR | |
|---|---|
| Filtre Ekleme/Kaldırma | Ctrl Shift L |
| Kılavuz Çizgilerini Gizleme Gösterme | Alt P Ç |
| Kaydet / Alternatif | Shift F12 |
| Altı Çizgili Yazdırma | Ctrl Shift A |
| Farklı Kaydetme | F12 |