Ignore this branch!
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor wrote:
> Hmmmm. I've spotted another deliberate mistake. Saving back the
> original document produces all the documents without the answers so
> it needs the white changing back to black (or auto) again ie
>
> The problem is undoubtedly with the section that names the files in
> the temporary folder that is overly complicated. I'll have to play
> around with that some more :(
>
> 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
> For Each aShape In .Shapes
> If aShape.Type = msoTextBox Then
> With aShape
> If .TextFrame.HasText Then
> .TextFrame.TextRange.Font.Color =
> wdColorAuto End If
> End With
> End If
> Next
> .SaveAs DocList
> .Close Savechanges:=wdDoNotSaveChanges
> End With
> DocList = Dir$()
> Loop
>
>
>
> I am using Acrobat 8 and I have the printing preferences set up as
> shown at http://www.gmayor.com/individual_merge_letters.htm
>
>
> 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...