#1
|
|||
|
|||
Splitting Out PDFs
test.docx
Hello, In my word document, I have paragraphs, each paragraph has a number, ie: the first paragraph is labelled 001, the second paragraph is labelled 002 and so on. What I want to do is have my VBA code in word match those paragraph numbers to an image with the same number, then have word automatically save the image & paragraph as one .pdf. So for example, the code would match paragraph 001 with image 001 and save it as 001.pdf Here is an example of what I got so far, (see attachment). The path to the images is K:\test\images\ the images are just saved on my hard drive they aren't in the word document Im just a little unsure as to where to go from here, I know how to get Word to save as a .pdf but I dont know how to get it to distinguish between the different paragraphs. Any help would be great! Thanks! |
#2
|
||||
|
||||
From what you've described, the code to insert the images would be something like:
Code:
Sub InsertPicsToPDF() Application.ScreenUpdating = False Dim Para As Paragraph, Str As String, i As Long, Rng As Range With ActiveDocument For Each Para In .Paragraphs Str = Trim(Para.Range.Words.First) If Str Like "###" Then Para.Range.InsertBefore Chr(12) Para.Range.InsertAfter vbCr .InlineShapes.AddPicture FileName:="K:\test\images\" & Str & ".jpg", _ LinkToFile:=False, SaveWithDocument:=True, Range:=Para.Range.Characters.Last End If Next .Characters.First.Delete For i = 1 To .ComputeStatistics(wdStatisticPages) Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") If Rng.Characters.Last = Chr(12) Then Rng.MoveEnd wdCharacter, -1 Str = Trim(Rng.Words.First) Rng.Copy Documents.Add With ActiveDocument .Range.Paste .SaveAs2 FileName:="K:\test\images\" & Str & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False .Close SaveChanges:=False End With Next End With Set Rng = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
RE:
Hey there,
Thanks for the response, Ive got some good news and bad news. The script saves a PDF AND it saves the pdf with the correct text and image. The only issue is, I want to add a space between the picture and the text...For example: Right now the text is on the same line as the image, like this: <Image><text> I would like it to be displayed like this: <Image>(centered on the page) vbNewLine <Text About The Image Here> (aligned left) I tried using Code:
Para.Range.InsertAfter vbNewLine Thanks! Here is the full code: Code:
Sub Splitter() Selection.EndKey Unit:=wdStory numlets = Selection.Information(wdActiveEndSectionNumber) If numlets > 1 Then numlets = numlets - 1 Selection.HomeKey Unit:=wdStory BaseName = "k:\test\images" For Counter = 1 To numlets DocName = BaseName & Right("0" & LTrim(Str(Counter)), 10) ActiveDocument.Sections.First.Range.Cut Documents.Add Selection.Paste Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 ActiveDocument.SaveAs FileName:=DocName, FileFormat:=wdFormatPDF ActiveWindow.Close Next Counter End Sub Sub InsertPicsToPDF() Application.ScreenUpdating = False Dim Para As Paragraph, Str As String, i As Long, Rng As Range With ActiveDocument For Each Para In .Paragraphs Str = Trim(Para.Range.Words.First) If Str Like "###" Then Para.Range.InsertBefore Chr(12) Para.Range.InsertAfter vbCr .InlineShapes.AddPicture FileName:="K:\test\images\" & Str & ".jpg", _ LinkToFile:=False, SaveWithDocument:=True, Range:=Para.Range.Characters.Last End If Next .Characters.First.Delete For i = 1 To .ComputeStatistics(wdStatisticPages) Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") If Rng.Characters.Last = Chr(12) Then Rng.MoveEnd wdCharacter, -1 Str = Trim(Rng.Words.First) Rng.Copy Documents.Add With ActiveDocument .Range.Paste .SaveAs2 FileName:="K:\test\images" & Str & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False .Close SaveChanges:=False End With Next End With Set Rng = Nothing Application.ScreenUpdating = True End Sub Last edited by macropod; 11-30-2012 at 04:49 PM. Reason: Deleted unnecessary quote of entire post replied to |
#4
|
||||
|
||||
Try:
Code:
Sub InsertPicsToPDF() Application.ScreenUpdating = False Dim Para As Paragraph, Str As String, i As Long, Rng As Range, sPath As String sPath = "K:\test\images\" With ActiveDocument For Each Para In .Paragraphs Str = Trim(Para.Range.Words.First) If Str Like "###" Then Set Rng = Para.Range With Rng .InsertBefore Chr(12) .Collapse wdCollapseEnd .InsertAfter vbCr .Collapse wdCollapseStart .ParagraphFormat.Alignment = wdAlignParagraphCenter End With .InlineShapes.AddPicture FileName:=sPath & Str & ".jpg", _ LinkToFile:=False, SaveWithDocument:=True, Range:=Rng End If Next .Characters.First.Delete For i = 1 To .ComputeStatistics(wdStatisticPages) Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") If Rng.Characters.Last = Chr(12) Then Rng.MoveEnd wdCharacter, -1 Str = Trim(Rng.Words.First) Rng.Copy Documents.Add With ActiveDocument .Range.Paste .SaveAs2 FileName:=sPath & Str & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False .Close SaveChanges:=False End With Next End With Set Rng = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Hey Pal,
Sorry for the late response. Thanks for the correction in code. Yeah the beginning part isn't necessary to worry about. Your code worked! The only thing, is it inserted the picture the way I described, except it inserted after the first sentence of the paragraph. (See attached photo for an example) citgo.pdf The image appears below the guys name "001 Joe Smith Process Engineer", it should be above the guy's name. Any idea why that might be? Thanks again for your help! Last edited by macropod; 12-03-2012 at 03:21 PM. Reason: Deleted unnecessary quote of entire previous post. |
#6
|
||||
|
||||
Quote:
Code:
With Rng .Collapse wdCollapseStart .InsertBefore Chr(12) & vbCr .MoveStart wdCharacter, 1 .ParagraphFormat.Alignment = wdAlignParagraphCenter End With
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
RE:
Thanks Pal!
Just a quick question, seems to work, sort of, I executed the Macro and got an error on this line Code:
.SaveAs2 FileName:=sPath & Str & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False Code:
Rng.Copy |
#8
|
|||
|
|||
RE:
Nope you know what, its definitely not the Rng.Copy aspect, its the
Code:
.SaveAs2 FileName:=sPath & Str & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False Sorry for the second post. |
#9
|
||||
|
||||
I overlooked a downstream effect. Change:
Str = Trim(Rng.Words.First) to: Str = Trim(Rng.Paragraphs(2).Range.Words.First)
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
|||
|
|||
RE:
Thanks man, let me try that out
|
#11
|
|||
|
|||
"The requested member of the colection oes not exist"
Was the error it gave me. |
#12
|
||||
|
||||
The code works fine when I use it. Are you sure you're running it on a fresh document?
PS: Please don't keep quoting entire previous posts in your replies. If there is something that you need to make particular reference to, quote just that part.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
RE:
Hey bud,
Sorry about all that. It seems to have worked this time. That was weird! Just kinda went all finnickie then started to work, hmm. Welp, thank you very much in any sense. I shall mark this as solved! |
#14
|
|||
|
|||
RE:
Hey There
Had to hard this as unsolved due to a delimma I just started encountering. The script was working fine, but just now (literally a few minutes ago) - suddenly when the macro got executed - the script started opening a new word document, then prompting me if I wanted to save that word document Any idea why that might be, script below, and I also attached a sample. Thanks test.docx Code:
Sub Splitter() Selection.EndKey Unit:=wdStory numlets = Selection.Information(wdActiveEndSectionNumber) If numlets > 1 Then numlets = numlets - 1 Selection.HomeKey Unit:=wdStory BaseName = "k:\test\images" For Counter = 1 To numlets DocName = BaseName & Right("0" & LTrim(Str(Counter)), 10) ActiveDocument.Sections.First.Range.Cut Documents.Add Selection.Paste Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 ActiveDocument.SaveAs FileName:=DocName, FileFormat:=wdFormatPDF ActiveWindow.Close Next Counter End Sub Sub InsertPicsToPDF() Application.ScreenUpdating = False Dim Para As Paragraph, Str As String, i As Long, Rng As Range, sPath As String sPath = "K:\test\images\" With ActiveDocument For Each Para In .Paragraphs Str = Trim(Para.Range.Words.First) If Str Like "###" Then Set Rng = Para.Range With Rng .Collapse wdCollapseStart .InsertBefore Chr(12) & vbCr .MoveStart wdCharacter, 1 .ParagraphFormat.Alignment = wdAlignParagraphCenter End With .InlineShapes.AddPicture FileName:=sPath & Str & ".jpg", _ LinkToFile:=False, SaveWithDocument:=True, Range:=Rng End If Next .Characters.First.Delete For i = 1 To .ComputeStatistics(wdStatisticPages) Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i) Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") If Rng.Characters.Last = Chr(12) Then Rng.MoveEnd wdCharacter, -1 Str = Trim(Rng.Paragraphs(2).Range.Words.First) Rng.Copy Documents.Add With ActiveDocument .Range.Paste .SaveAs2 FileName:=sPath & Str & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False .Close SaveChanges:=False End With Next End With Set Rng = Nothing Application.ScreenUpdating = True End Sub |
#15
|
||||
|
||||
Are you sure you're not trying to save over files you've already created in a previous run of the macro?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Inserted PDFs become Pixelated in Powerpoint | fongchun | PowerPoint | 0 | 11-26-2012 06:24 PM |
My Word 2007 doesnt display PDFs correctly | mattk561 | Word | 8 | 10-31-2012 08:04 PM |
Embedding PDFs in MS Word 2010 | chitownbillj | Word | 1 | 06-30-2012 12:01 AM |
Creating High Quality PDFs from Word 2010 | BrazzellMarketing | Word | 11 | 01-27-2012 01:06 PM |
Converting Powerpoint into Fully Accessable PDFs | KCD123 | PowerPoint | 4 | 09-28-2011 10:03 AM |