MS Word 2016 VBA update document for each copy printed at one time 1

[Christopher Lauer]

Good day,
I would like the ability to update a document each time it is printed via the Print dialog box when the User selects to print X copies. For example, when the user selects 2 copies, I need to run my code twice, once before the first print (I have figured this out using the DocumentBeforePrint() method) and then before the second print (where I am stuck).
I think this may not be possible as I think it is the onboard printer code that says print this same file X times, not Word that says send this document X times.

Project overview:
I am creating a word template (.dotm) that contains six “coupons”. I am prompting the user for Sale Price, Retail Price, Start Date, End Date and Starting Serial Number on Document_New(). I then populate the six copies of the coupon with the collated, validated, data; the Seral Number for each coupon is incremented by one so all six have a different seral number (1 – 6 if 1 is entered). This is working just fine.
I will need to print like 100 of these coupons and so it would be nice to say Print 17 copies so I only need to enter the coupon data once and have “code” update the six serial numbers on each copy.

What do you think? Is this doable in VBA?

My background:
I was a VB/VB.NET desktop and web developer for about 10 years then moved on to SQL Server Development and have been a SQL Developer and DBA for the past 5 years. I have not programmed in Office before. I can think of numerous ways to tackle this using SQL SSRS but this is for a Boy Scout troop and needs to be something I can “handoff” to the next leadership team. Office or Excel appears to be the “easy to use” way at this point.

 

[kjv1611]

Interesting idea.

You'll need to post in this forum for best answers and discussion:
forum707

I don't think it's possible to control the print control outside of Word (at least without some seriously laborious code possibly with APIs), but I don't see why you couldn't play with just using perhaps a userform, and increment a Label while the items are printing. Something along those lines. If it doesn't HAVE to be exact, you could just guess at average timing, perhaps, and use that to space everyhting out. Otherwise, you may have to go the API route to tie into the print queue.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[combo]

It depends how much you need to automate this task. With some manual work you could create excel file with variable data and use mailmerge word feature: create template with fields, link to excel data, and generate document with pages containing data from the rows in data source.

combo

 

[Christopher Lauer]

As usual, after looking for answers to my own question for the past two days and then posting my question I found a solution that will work for me at

https://wordmvp.com/FAQs/MacrosVBA/NumberCopiesOf1Doc.htm

My version of this code just in case someone else can avoid a headache from mine:

Option Explicit

'Private oWordEvents As WordEvents
Dim iNumCopiesToPrint As Integer
Dim iSerialNumberStart As Integer

Const SERIAL_NUMBER_KEY As String = "4.5PottedPlant"
Const SERIAL_NUMBER_SETTINGS_FILE As String = "C:\temp\BS_Plant_Settings.txt"

Private Sub Document_Open()
'Set oWordEvents = New WordEvents
End Sub

Private Sub Document_New()
Dim iSalePrice As Integer
Dim iRetailPrice As Integer
Dim dtStartDate As Date
Dim strStartDate As String
Dim dtEndDate As Date
Dim strEndDate As String
Dim strSerialNumber As String
Dim iCounter As Integer

Dim cc As ContentControl
Dim docCCs As ContentControls

'Set oWordEvents = New WordEvents

MsgBox ("This document contains code to populate the following items: Sale Price, Retail Price, Start Date, End Date and starting Serial Number for the coupon. After you click OK on this message you will prompted for one piece of information at a time (you will receive 5 prompts). Please read the prompts carefully so you enter the correct data.")

'***********************************************************************************************
' Collect User input
'***********************************************************************************************

iSalePrice = InputBox("Enter the Sale Price." & vbCrLf & "Do not enter dallor sign and inclue cents. " & vbCrLf & "Example: 5.50", "Sale Price", "0.00")
iRetailPrice = InputBox("Enter the Retail Price." & vbCrLf & "Do not enter dallor sign and inclue cents. " & vbCrLf & "Example: 5.50", "Retail Price", "0.00")
strStartDate = InputBox("Enter the Start Date of product pickup in format of mm/dd/yyyy", "Start Date", Format(Now(), "mm/dd/yyyy"))
strEndDate = InputBox("Enter the End Date of product pickup in format of mm/dd/yyyy", "End Date", Format(Now(), "mm/dd/yyyy"))

iNumCopiesToPrint = Val(InputBox("Enter the number of copies that you want to print", "Number of Copies", 1))

'get last serial number from the Microsoft Windows registry.
strSerialNumber = Val(System.PrivateProfileString(SERIAL_NUMBER_SETTINGS_FILE, "MacroSettings", SERIAL_NUMBER_KEY))
'does it exhist?
If strSerialNumber = "" Then 'no
iSerialNumberStart = 1
Else 'yes
iSerialNumberStart = Val(strSerialNumber)
End If

iSerialNumberStart = InputBox("Override starting Serial Number?" & vbCrLf & "Last Serial Number printed from THIS computer is set as the default", "Starting Serial Number", iSerialNumberStart)


If IsDate(strStartDate) Then
dtStartDate = Format(CDate(strStartDate), "mm/dd/yyyy")
Else
MsgBox "Invalid date for Start Date"
Exit Sub
End If

If IsDate(strEndDate) Then
dtEndDate = Format(CDate(strEndDate), "mm/dd/yyyy")
Else
MsgBox "Invalid date for End Date"
Exit Sub
End If
'***********************************************************************************************
' Collect User input END
'***********************************************************************************************

'***********************************************************************************************
' Populate document
'***********************************************************************************************

' Get the collection of all content controls with this tag.
Set docCCs = ActiveDocument.SelectContentControlsByTag("iSalePriceOfItem")
' If any content controls are found iterate through them and give the type.
If docCCs.Count <> 0 Then
For Each cc In docCCs
cc.Range.Text = Format(iSalePrice, "#,###.##")
Next
Else
MsgBox "No content controls found with that tag value: iSalePriceOfItem."
End If

' Get the collection of all content controls with this tag.
Set docCCs = ActiveDocument.SelectContentControlsByTag("iRetailPriceOfItem")
' If any content controls are found iterate through them and give the type.
If docCCs.Count <> 0 Then
For Each cc In docCCs
cc.Range.Text = Format(iRetailPrice, "#,###.##")
Next
Else
MsgBox "No content controls found with that tag value: iRetailPriceOfItem."
End If

' Get the collection of all content controls with this tag.
Set docCCs = ActiveDocument.SelectContentControlsByTag("dtStartDateOfPickup")
' If any content controls are found iterate through them and give the type.
If docCCs.Count <> 0 Then
For Each cc In docCCs
cc.Range.Text = dtStartDate
Next
Else
MsgBox "No content controls found with that tag value: dtStartDateOfPickup."
End If

' Get the collection of all content controls with this tag.
Set docCCs = ActiveDocument.SelectContentControlsByTag("dtEndDateOfPickup")
' If any content controls are found iterate through them and give the type.
If docCCs.Count <> 0 Then
For Each cc In docCCs
cc.Range.Text = dtEndDate
Next
Else
MsgBox "No content controls found with that tag value: dtEndDateOfPickup."
End If
'***********************************************************************************************
' Populate document END
'***********************************************************************************************

'***********************************************************************************************
' print after populating the serial numbers
'***********************************************************************************************

iCounter = 0
While iCounter < iNumCopiesToPrint
UpdateSerialNumbersPriorToPrint (iSerialNumberStart)
ActiveDocument.PrintOut
iSerialNumberStart = iSerialNumberStart + 6
iCounter = iCounter + 1
Wend
'***********************************************************************************************
' print after populating the serial numbers END
'***********************************************************************************************

'Save the next number back to the Settings.txt file ready for the next use.
System.PrivateProfileString(SERIAL_NUMBER_SETTINGS_FILE, "MacroSettings", SERIAL_NUMBER_KEY) = CStr(iSerialNumberStart)
End Sub

Private Sub UpdateSerialNumbersPriorToPrint(ByVal serialNumber As Integer)
Dim cc As ContentControl

Set cc = ActiveDocument.SelectContentControlsByTag("iSerialNumber1")(1)
cc.Range.Text = Format(serialNumber, "0000000000")

Set cc = ActiveDocument.SelectContentControlsByTag("iSerialNumber2")(1)
cc.Range.Text = Format(serialNumber + 1, "0000000000")

Set cc = ActiveDocument.SelectContentControlsByTag("iSerialNumber3")(1)
cc.Range.Text = Format(serialNumber + 2, "0000000000")

Set cc = ActiveDocument.SelectContentControlsByTag("iSerialNumber4")(1)
cc.Range.Text = Format(serialNumber + 3, "0000000000")

Set cc = ActiveDocument.SelectContentControlsByTag("iSerialNumber5")(1)
cc.Range.Text = Format(serialNumber + 4, "0000000000")

Set cc = ActiveDocument.SelectContentControlsByTag("iSerialNumber6")(1)
cc.Range.Text = Format(serialNumber + 5, "0000000000")
End Sub

 

[kjv1611]

Thanks for sharing what worked.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57