VBA Critique

[roy.ball]

I would really appreciate some input from the fine people of this group
[microsoft.public.word.vba.beginners]. The following is a description
of my situation, directly followed by my script. Yes - I recorded
macros to get the nuts and bolts of the script.

Thanks in advance!


Our application writes a data and token file to the users PC and then
invokes Word for the merge. I had a request to generate trial notices
en mass, but the user wanted them grouped by department copy. When
trial notices are generated, five copies are created, one for each
department, but they must be grouped by department. This prevents me
from doing the usual and creating a 5-page merge template, one page for
each department.

The following script first stores the default printer, and then
specifies the printer to use for this document. From here, the merge is
performed and a dynamic department name is inserted into the footer.
The template is merged, sent to the printer, and then closed. The
process then repeats itself for the remaining departments

Finally, the printer is set back to the default.

Here is the script

Sub formcopy()
'
' Copy Script
' Created 9/7/2005 by Roy Ball
'
' This VBA script selects the page footer,
' inserts the copy text, merges the CourtView
' data, prints the forms for that recipient(s)
' closes the merged data form, and resets the
' footer text.

'PrntScrpt

Dim sCurrentPrinter As String

On Error Resume Next

sCurrentPrinter = ActivePrinter
ActivePrinter = "\\cocprint01\is-hp4200-1"

' Defendant Copy
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.ParagraphFormat.Alignment =
wdAlignParagraphCenter
Selection.TypeText Text:="DEFENDANT COPY"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With

Application.PrintOut FileName:="",
Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False,
PrintZoomColumn:=0, _
PrintZoomRow:=0, PrintZoomPaperWidth:=0,
PrintZoomPaperHeight:=0
ActiveWindow.Close (wdDoNotSaveChanges)
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'!Defendant Copy

' Bondsman Copy
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.ParagraphFormat.Alignment =
wdAlignParagraphCenter
Selection.TypeText Text:="BONDSMAN COPY"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
Application.PrintOut FileName:="",
Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False,
PrintZoomColumn:=0, _
PrintZoomRow:=0, PrintZoomPaperWidth:=0,
PrintZoomPaperHeight:=0
ActiveWindow.Close (wdDoNotSaveChanges)
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'!Bondsman Copy

' Admin Copy
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.ParagraphFormat.Alignment =
wdAlignParagraphCenter
Selection.TypeText Text:="ADMIN COPY"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
Application.PrintOut FileName:="",
Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False,
PrintZoomColumn:=0, _
PrintZoomRow:=0, PrintZoomPaperWidth:=0,
PrintZoomPaperHeight:=0
ActiveWindow.Close (wdDoNotSaveChanges)
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'!Admin Copy

' Attorney Copy
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.ParagraphFormat.Alignment =
wdAlignParagraphCenter
Selection.TypeText Text:="ATTORNEY COPY"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
Application.PrintOut FileName:="",
Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False,
PrintZoomColumn:=0, _
PrintZoomRow:=0, PrintZoomPaperWidth:=0,
PrintZoomPaperHeight:=0
ActiveWindow.Close (wdDoNotSaveChanges)
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'!Attorney Copy

' Clerk Copy
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.ParagraphFormat.Alignment =
wdAlignParagraphCenter
Selection.TypeText Text:="CLERKS COPY"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
Application.PrintOut FileName:="",
Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False,
PrintZoomColumn:=0, _
PrintZoomRow:=0, PrintZoomPaperWidth:=0,
PrintZoomPaperHeight:=0
ActiveWindow.Close (wdDoNotSaveChanges)
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'!Clerk Copy

ActivePrinter = sCurrentPrinter
'!PrntScrpt


End Sub

 

[Jean-Guy Marcil]

(e-mail address removed) was telling us:
(e-mail address removed) nous racontait que :

I would really appreciate some input from the fine people of this
group [microsoft.public.word.vba.beginners]. The following is a
description of my situation, directly followed by my script. Yes - I
recorded macros to get the nuts and bolts of the script.

Thanks in advance!


Our application writes a data and token file to the users PC and then
invokes Word for the merge. I had a request to generate trial notices
en mass, but the user wanted them grouped by department copy. When
trial notices are generated, five copies are created, one for each
department, but they must be grouped by department. This prevents me
from doing the usual and creating a 5-page merge template, one page
for each department.

The following script first stores the default printer, and then
specifies the printer to use for this document. From here, the merge
is performed and a dynamic department name is inserted into the
footer. The template is merged, sent to the printer, and then closed.
The process then repeats itself for the remaining departments

Finally, the printer is set back to the default.

Try avoiding the Selection object and opening header/footer pane.... that
can quickly lead to problems. Also, do not use a generic On Error Resume
Next, that can create all kinds of trouble for the user if a major error is
generated but Word is trying to carry on nevertheless. Finally, instead of
repeating the same code 5 times, especially when it is a bit longish, create
a separate Sub or Function and call it from the main Sub.

Try this out:

'_______________________________________
Sub formcopy()
'
' This VBA script inserts the copy text in
' the page footer, merges the CourtView
' data, prints the forms for that recipient(s)
' closes the merged data form, and resets the
' footer text.

'PrntScrpt
Dim sCurrentPrinter As String

On Error Resume Next 'Not a good idea... Better
'test the code under different
'conditions and code to take
'into account the different
'errors that can occur
'Or leave it out and let Word
'generate error messages

sCurrentPrinter = ActivePrinter
ActivePrinter = "\\cocprint01\is-hp4200-1"

' Defendant Copy
CreateCopies "DEFENDANT COPY"
'!Defendant Copy

' Bondsman Copy
CreateCopies "BONDSMAN COPY"
'!Bondsman Copy

' Admin Copy
CreateCopies "ADMIN COPY"
'!Admin Copy

' Attorney Copy
CreateCopies "ATTORNEY COPY"
'!Attorney Copy

' Clerk Copy
CreateCopies "CLERKS COPY"
'!Clerk Copy

ActivePrinter = sCurrentPrinter
'!PrntScrpt

End Sub
'_______________________________________

'_______________________________________
Private Sub CreateCopies(FooterText As String)

Dim FooterRge As Range

Set FooterRge = ActiveDocument.Sections(1) _
.Footers(wdHeaderFooterPrimary).Range

With FooterRge
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Text = FooterText
End With

With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With

Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages,
_
Collate:=True, Background:=True, PrintToFile:=False, PrintZoomColumn:=0,
_
PrintZoomRow:=0, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0

ActiveDocument.Close wdDoNotSaveChanges

With FooterRge
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Text = ""
End With

End Sub
'_______________________________________

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Roy]

Thanks so much for the feedback. I knew there had to be a way to
consolidate the code. I had to build this in about 5 minutes - with
about 10 minutes worth of VBA training. I took your advice and tested
my script to ensure there would not be any issues in any of our
different user environments. Unfortunately, the client has a "If it's
not broke" mentality so I can't incorporate your ideas. But I will
archive your solution as the same rules apply many times for Court
Trial notices.

Thanks again!

--Roy