[]
Word to PDF otomasyonu -600 sayfa
elimde 600 sayfalık bir word var. bu word dosyasının her iki sayfası bir pdf olacak şekilde pdf kaydetmek istiyorum.
örneğin 1-2 sayfalar 1 pdf (mümkünse word içindeki mail mergeten gelen <<İsim>> datası ile isimlendirilmiş), 3-4 sayfalar 1 pdf (yine aynı şekilde isimlendirilimş) vs vs şeklinde ilerler bu iş.
nasıl yapabileceğimi veya yapıp yapamayacağımı bulamadım. gurulara geldim. varsa EN/TR kaynak da olur.
ellerinizden öperim.
örneğin 1-2 sayfalar 1 pdf (mümkünse word içindeki mail mergeten gelen <<İsim>> datası ile isimlendirilmiş), 3-4 sayfalar 1 pdf (yine aynı şekilde isimlendirilimş) vs vs şeklinde ilerler bu iş.
nasıl yapabileceğimi veya yapıp yapamayacağımı bulamadım. gurulara geldim. varsa EN/TR kaynak da olur.
ellerinizden öperim.
şöyle bir araç var.
eksisozluk.com
buna pdf şeklinde yükleyip sonra böldürebilirsin gibi geldi. yada iyi bir inceleyin.
eksisozluk.com
buna pdf şeklinde yükleyip sonra böldürebilirsin gibi geldi. yada iyi bir inceleyin.
- sivri sinek
(07.08.25 13:29:26)
aşağıdaki kodu geliştirici menüsü altındaki visual basic kısmına kopyalayıp çalıştırın istediğiniz gibi yapacaktır.
geliştirici kısmı nasıl açılır bilmiyorsanız : www.youtube.com
kodu module kısmından çalıştırmanız daha iyi olur www.youtube.com
Sub WordToPDF()
Application.ScreenUpdating = False
Dim totalPages As Long
Dim currentPage As Long
Dim rng As Range
Dim tempDoc As Document
Dim pdfName As String
Dim savePath As String
Dim personName As String
Dim startRange As Range, endRange As Range
Dim startPos As Long, endPos As Long
ActiveDocument.Repaginate
totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
savePath = InputBox("PDF'lerin kaydedileceği klasör yolunu girin:", "Kayıt Yolu")
If Right(savePath, 1) <> "\" Then savePath = savePath & "\"
For currentPage = 1 To totalPages Step 2
Set startRange = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=CStr(currentPage))
startPos = startRange.Start
If currentPage + 1 <= totalPages Then
Set endRange = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=CStr(currentPage + 2))
endPos = endRange.Start
Else
endPos = ActiveDocument.Content.End
End If
Set rng = ActiveDocument.Range(Start:=startPos, End:=endPos)
Set tempDoc = Documents.Add
rng.Copy
tempDoc.Range.Paste
personName = ExtractName(tempDoc)
If personName = "" Then
personName = "Sayfa_" & currentPage & "-" & (currentPage + 1)
End If
personName = CleanFileName(personName)
pdfName = savePath & personName & ".pdf"
tempDoc.ExportAsFixedFormat OutputFileName:=pdfName, ExportFormat:=wdExportFormatPDF
tempDoc.Close SaveChanges:=False
Next currentPage
MsgBox "Tüm PDF dosyaları oluşturuldu!"
Application.ScreenUpdating = True
End Sub
Function ExtractName(doc As Document) As String
Dim r As Range
Set r = doc.Content.Duplicate
With r.Find
.Text = "<[A-Z]*>* <[A-Z]*>*"
.MatchWildcards = True
If .Execute Then
ExtractName = r.Text
Else
ExtractName = ""
End If
End With
End Function
Function CleanFileName(fileName As String) As String
Dim invalidChars As Variant
Dim i As Integer
invalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
For i = LBound(invalidChars) To UBound(invalidChars)
fileName = Replace(fileName, invalidChars(i), "_")
Next i
CleanFileName = Trim(fileName)
End Function
geliştirici kısmı nasıl açılır bilmiyorsanız : www.youtube.com
kodu module kısmından çalıştırmanız daha iyi olur www.youtube.com
Sub WordToPDF()
Application.ScreenUpdating = False
Dim totalPages As Long
Dim currentPage As Long
Dim rng As Range
Dim tempDoc As Document
Dim pdfName As String
Dim savePath As String
Dim personName As String
Dim startRange As Range, endRange As Range
Dim startPos As Long, endPos As Long
ActiveDocument.Repaginate
totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
savePath = InputBox("PDF'lerin kaydedileceği klasör yolunu girin:", "Kayıt Yolu")
If Right(savePath, 1) <> "\" Then savePath = savePath & "\"
For currentPage = 1 To totalPages Step 2
Set startRange = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=CStr(currentPage))
startPos = startRange.Start
If currentPage + 1 <= totalPages Then
Set endRange = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=CStr(currentPage + 2))
endPos = endRange.Start
Else
endPos = ActiveDocument.Content.End
End If
Set rng = ActiveDocument.Range(Start:=startPos, End:=endPos)
Set tempDoc = Documents.Add
rng.Copy
tempDoc.Range.Paste
personName = ExtractName(tempDoc)
If personName = "" Then
personName = "Sayfa_" & currentPage & "-" & (currentPage + 1)
End If
personName = CleanFileName(personName)
pdfName = savePath & personName & ".pdf"
tempDoc.ExportAsFixedFormat OutputFileName:=pdfName, ExportFormat:=wdExportFormatPDF
tempDoc.Close SaveChanges:=False
Next currentPage
MsgBox "Tüm PDF dosyaları oluşturuldu!"
Application.ScreenUpdating = True
End Sub
Function ExtractName(doc As Document) As String
Dim r As Range
Set r = doc.Content.Duplicate
With r.Find
.Text = "<[A-Z]*>* <[A-Z]*>*"
.MatchWildcards = True
If .Execute Then
ExtractName = r.Text
Else
ExtractName = ""
End If
End With
End Function
Function CleanFileName(fileName As String) As String
Dim invalidChars As Variant
Dim i As Integer
invalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
For i = LBound(invalidChars) To UBound(invalidChars)
fileName = Replace(fileName, invalidChars(i), "_")
Next i
CleanFileName = Trim(fileName)
End Function
- pislick0
(07.08.25 13:36:32)
1
