microsoft.public.word.vba.general

Hmmmm. I've spotted another deliberate mistake, and in sorting out that it
seems easier to process in three separate operations - creating the extra
files, formatting the blanked out text, and printing to PDF.

I am using Acrobat 8 and I have the printing preferences set up as shown at
http://www.gmayor.com/individual_merge_letters.htm

Now someone will come along and show us how it could have been done more
simply ;)

Sub BatchPrint2PDF()
Dim DocList As String
Dim DocDir As String
Dim sPrinter As String
Dim aShape As Shape
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.Title = "Select Folder containing the documents to be printed to PDF
and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
DocDir = fDialog.SelectedItems.Item(1)
If Right(DocDir, 1) <> "\" Then DocDir = DocDir + "\"
End With

On Error Resume Next
MkDir DocDir & "Temp\"

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If

'First loop creates the extra documents in the temporary folder
DocList = Dir$(DocDir & "*.doc")
Do While DocList <> ""
Documents.Open DocList
With ActiveDocument
sname = Left$(.name, (Len(.name) - 4)) & "A.doc"
.SaveAs DocDir & "Temp\" & sname
.SaveAs DocList
sname = Left$(.name, (Len(.name) - 4)) & "Q.doc"
.SaveAs DocDir & "Temp\" & sname
.SaveAs DocList
.Close SaveChanges:=wdDoNotSaveChanges
End With
DocList = Dir$()
Loop

'Second loop formats all the files ending in Q.doc to lose the answers
DocList = Dir$(DocDir & "Temp\*Q.doc")
Do While DocList <> ""
ChDir DocDir & "Temp\"
Documents.Open DocList
With ActiveDocument
For Each aShape In .Shapes
If aShape.Type = msoTextBox Then
With aShape
If .TextFrame.HasText Then
.TextFrame.TextRange.Font.Color =
wdColorWhite
End If
End With
End If
Next
.Close SaveChanges:=wdSaveChanges
End With
DocList = Dir$()
Loop

'Final loop outputs all the document files in the temp folder to PDF
DocList = Dir$(DocDir & "Temp\*.doc")
Do While DocList <> ""
ChDir DocDir & "Temp\"
Documents.Open DocList
ActivePrinter = sPrinter
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = "Adobe PDF"
.DoNotSetAsSysDefault = True
.Execute
End With
With ActiveDocument
.PrintOut
ActivePrinter = sPrinter
.Close SaveChanges:=wdDoNotSaveChanges
End With
DocList = Dir$()
Loop
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>



Dan B wrote:
> I've managed to tweak the PDF driver setup and Acrobat doesn't always
> stick now.
>
> However, the macro seems to only convert the first word doc it finds
> in the folder and then stops. Also, trying to convert with a
> previous Temp folder in place seems to make Acrobat stick. Is there
> a way we can delete the previous Temp folder before proceeding with
> conversion?
>
> Any ideas?
>
> If you get things working, is there any chance you can send me a
> screenshot of how you have your PDF driver setup?
>
> Cheers,
>
> Dan.
>
> "Dan B" wrote:
>
>> Acrobat appears to get stuck when creating the second PDF (Q.doc).
>>
>> Maybe this needs tweaking. Any ideas?
>>
>> "Graham Mayor" wrote:
>>
>>> The following appears to work. As for the question about Word 2007,
>>> then apart from the fact that for this particular issue the ability
>>> to *Save* as PDF would have made things a tad simpler, I prefer to
>>> work in 2003. Word 2007 will make your life a whole lot more
>>> complicated than it needs to be.
>>>
>>> The macro creates (where it doesn't already exist) a folder called
>>> Temp as a sub folder of the folder that contains the documents. A
>>> loop then saves the documents, running your code to reformat the
>>> text boxes, along the way with the addition of Q to signify
>>> questions only and A to signify questions and answers (which is
>>> what you originally requested). Another loop then runs on the Temp
>>> folder to print to the Adobe driver, which will create its files
>>> wherever you have told the driver to do so.
>>>
>>> I have had to insert a couple of extra save as processes and a
>>> couple of ChDir commands as the macro seemed to lose track of where
>>> it was working without them. I am sure there must be a better way,
>>> but I can't immediately see it. Unfortunately I don't know enough
>>> about addressing the Adobe driver directly to offer that as a
>>> simpler alternative, but that should be possible.
>>>
>>> Sub BatchPrint2PDF()
>>> Dim DocList As String
>>> Dim DocDir As String
>>> Dim sPrinter As String
>>> Dim aShape As Shape
>>> Dim fDialog As FileDialog
>>> Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
>>>
>>> With fDialog
>>> .Title = "Select Folder containing the documents to be printed
>>> to PDF and click OK"
>>> .AllowMultiSelect = False
>>> .InitialView = msoFileDialogViewList
>>> If .Show <> -1 Then
>>> MsgBox "Cancelled By User"
>>> Exit Sub
>>> End If
>>> DocDir = fDialog.SelectedItems.Item(1)
>>> If Right(DocDir, 1) <> "\" Then DocDir = DocDir + "\"
>>> End With
>>> On Error Resume Next
>>> MkDir DocDir & "Temp\"
>>>
>>> If Documents.Count > 0 Then
>>> Documents.Close Savechanges:=wdPromptToSaveChanges
>>> End If
>>> DocList = Dir$(DocDir & "*.doc")
>>> Do While DocList <> ""
>>> Documents.Open DocList
>>> With ActiveDocument
>>> sname = Left$(.name, (Len(.name) - 4)) & "A.doc"
>>> .SaveAs DocDir & "Temp\" & sname
>>> .SaveAs DocList
>>> For Each aShape In .Shapes
>>> If aShape.Type = msoTextBox Then
>>> With aShape
>>> If .TextFrame.HasText Then
>>> .TextFrame.TextRange.Font.Color =
>>> wdColorWhite End If
>>> End With
>>> End If
>>> Next
>>> sname = Left$(.name, (Len(.name) - 4)) & "Q.doc"
>>> .SaveAs DocDir & "Temp\" & sname
>>> .SaveAs DocList
>>> .Close Savechanges:=wdDoNotSaveChanges
>>> End With
>>> DocList = Dir$()
>>> Loop
>>>
>>> DocList = Dir$(DocDir & "Temp\*.doc")
>>> Do While DocList <> ""
>>> ChDir DocDir & "Temp\"
>>> Documents.Open DocList
>>> ActivePrinter = sPrinter
>>> With Dialogs(wdDialogFilePrintSetup)
>>> sPrinter = .Printer
>>> .Printer = "Adobe PDF"
>>> .DoNotSetAsSysDefault = True
>>> .Execute
>>> End With
>>> With ActiveDocument
>>> .PrintOut
>>> ActivePrinter = sPrinter
>>> .Close Savechanges:=wdDoNotSaveChanges
>>> End With
>>> DocList = Dir$()
>>> Loop
>>> End Sub
>>>
>>> --
>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>> Graham Mayor - Word MVP
>>>
>>> My web site www.gmayor.com
>>> Word MVP web site http://word.mvps.org
>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>>
>>>
>>> Dan B wrote:
>>>> Thanks Graham - really appreciate it.
>>>>
>>>> Would you say that Word 2007 makes life easier in terms of macro
>>>> development and general use? Maybe I should push the boss for an
>>>> upgrade.
>>>>
>>>> "Graham Mayor" wrote:
>>>>
>>>>> I was afraid you might be using Word 2003 ;) Leave it with me for
>>>>> a bit. I'll have a play around.
>>>>>
>>>>> --
>>>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>>>> Graham Mayor - Word MVP
>>>>>
>>>>> My web site www.gmayor.com
>>>>> Word MVP web site http://word.mvps.org
>>>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>>>>
>>>>>
>>>>> Dan B wrote:
>>>>>> The code I'm using to 'hide' the answers is actually just
>>>>>> adjusting the font colour of all text in text boxes (from dark
>>>>>> grey to white):
>>>>>>
>>>>>> Sub HideAnswers()
>>>>>>
>>>>>> ' Find each text box and set it's font colour to white
>>>>>>
>>>>>> Dim aShape As Shape
>>>>>>
>>>>>> For Each aShape In ActiveDocument.Shapes
>>>>>> If aShape.Type = msoTextBox Then
>>>>>> With aShape
>>>>>> If .TextFrame.HasText Then
>>>>>> .TextFrame.TextRange.Font.Color = wdColorWhite
>>>>>> End If
>>>>>> End With
>>>>>> End If
>>>>>> Next
>>>>>>
>>>>>> End Sub
>>>>>>
>>>>>> To show the answers I use another macro to do the reverse (change
>>>>>> font colour in text boxes from white back to grey).
>>>>>>
>>>>>> I'm using Word 2003 and ideally I will need the solution to work
>>>>>> on Word XP.
>>>>>>
>>>>>> Cheers,
>>>>>>
>>>>>> Dan.
>>>>>>
>>>>>> "Graham Mayor" wrote:
>>>>>>
>>>>>>> I looked at this late yesterday and decided that it lacked an
>>>>>>> essential bit of information that I was going to come back to
>>>>>>> this morning.
>>>>>>>
>>>>>>> 3) Hide the answers using macro built into doc.
>>>>>>>
>>>>>>> I think we need to know more about how the documents are hidden
>>>>>>> in order to create a seamless process; other than that I was
>>>>>>> working along the same lines to create a temporary folder to
>>>>>>> catch the documents in order to allow Acrobat to create the
>>>>>>> PDFs using the file names, but it should be possible to use the
>>>>>>> macro to generate the file names (if I knew a bit more about
>>>>>>> the Acrobat object model)
>>>>>>>
>>>>>>> I also wondered at the Word version as this is altogether much
>>>>>>> easier in Word 2007 which can *save* documents in PDF format,
>>>>>>> thus making the naming easier and avoiding the use of the print
>>>>>>> function altogether.
>>>>>>>
>>>>>>> --
>>>>>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>>>>>> Graham Mayor - Word MVP
>>>>>>>
>>>>>>> My web site www.gmayor.com
>>>>>>> Word MVP web site http://word.mvps.org
>>>>>>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>>>>>>
>>>>>>>
>>>>>>> Jean-Guy Marcil wrote:
>>>>>>>> "Dan B" wrote:
>>>>>>>>
>>>>>>>>> Hi.
>>>>>>>>>
>>>>>>>>> I have a series of question / answer sheets as word docs. Each
>>>>>>>>> Word doc has macros to show or hide answers. My intention is
>>>>>>>>> perform a batch process to all docs as follows:
>>>>>>>>>
>>>>>>>>> 1) Open doc.
>>>>>>>>> 2) Print to PDF (answers showing by default) using word doc
>>>>>>>>> filename as PDF filename.
>>>>>>>>> 3) Hide the answers using macro built into doc.
>>>>>>>>> 4) Print a second PDF using word doc filename (but replace the
>>>>>>>>> last character 'a' with 'q') as PDF filename.
>>>>>>>>>
>>>>>>>>
>>>>>>>> Here is one way of going about it:
>>>>>>>>
>>>>>>>> Declare a document object, like:
>>>>>>>> Dim docProcess As Document
>>>>>>>> Once your code has made sure that there are documents to
>>>>>>>> process, create a sub directory for the Student versions
>>>>>>>> (parentDirectory\Student)
>>>>>>>> Use the doc object to open the first doc in the list:
>>>>>>>> Set docProcess= Documents.Open(DocList)
>>>>>>>> Use the doc to do the processing:
>>>>>>>> With docProcess
>>>>>>>> .Printout
>>>>>>>> .etc
>>>>>>>> End With
>>>>>>>> Since the easiest way to gt the PDF name is to ge it from the
>>>>>>>> Word doc, I would recommend doing a Save As with the suffix
>>>>>>>> you want to the new Student subdirectory.
>>>>>>>> Run the macro in that new doc by using something like:
>>>>>>>> ProjectName.ModuleName.SubName
>>>>>>>> Create the PDF.
>>>>>>>> Close the document.
>>>>>>>> Delete this doc document.
>>>>>>>> Repeat and rinse.
>>>>>>>>
>>>>>>>> This way, when you are done, you will have a sub directory with
>>>>>>>> the PDF Question documents attached to the parent directory
>>>>>>>> which will contain both the PDF and the Word Answer sheet.
>>>>>>>>
>>>>>>>> This solution will require more code than I have time to write
>>>>>>>> right now. You may try and ask specific questions with the
>>>>>>>> parts you are having problems with.
>>>>>>>>
>>>>>>>> Or course, someone will drop in with a much simpler
>>>>>>>> solution... I always complicate things...