microsoft.public.word.vba.general

Yes!

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

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


Dan B wrote:
> Does the macro create all of the Q and A docs before starting any PDF
> conversion?
>
> "Graham Mayor" wrote:
>
>> Yes - it is working here.
>> I have put three identical documents, each containing a text box
>> with sample text, in an otherwise empty folder.
>> The macro creates the six renamed files in the Temp folder, hides the
>> content of the text box and creates six PDF files, three with the
>> text box content, three without.
>> I don't know what else to suggest.
>>
>> --
>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>> Graham Mayor - Word MVP
>>
>> My web site www.gmayor.com
>> Word MVP web site http://word.mvps.org
>> <>>< ><<> ><<> <>>< ><<> <>>< <>><<>
>>
>>
>> Dan B wrote:
>>> Sorry Graham, but it still sticks on the second PDF conversion.
>>>
>>> I have Acrobat 8 set up the same as you.
>>>
>>> Are you getting a successful batch convsersion at your end?
>>>
>>> Dan.
>>>
>>> "Graham Mayor" wrote:
>>>
>>>> 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