Label template

[Karen Sigel]

Some time ago (with considerable help from the wizards on this and other Word VBA user sites), I was able to develop a userform that allows users to create letterhead from a template by selecting the correct return address from a drop-down list (linked to a centrally-stored Excel file). It’s been working like a charm, and I’ve even been able to use the base code from it to create templates for envelopes and other miscellaneous company transmittals and reports. The code is included below.

Now I’ve been asked if I can start with those existing templates and create a new one that will print shipping labels (Avery 5164) in standard company format. Our staff currently uses an agglomeration of Avery Wizard, AveryDesignPro, Word’s mail merge tool, or an Excel spreadsheet that’s VBA coded to send the print to either the whole sheet of labels or a specific label on the sheet.

My problem is, we’ve undergone a corporate rebranding effort and the old Excel label tool doesn’t work any more because the label format has changed, and the guy who wrote it 11 years ago has retired and moved on. And, inany case, the only thing it does is place the print correctly; you still have to manually enter the return and recipient addresses. Neither of Avery’s tools works because we can’t create our own template in them.

What I’d like to do is use the userform I have to select the return address and incorporate the ability to choose to print it on all six labels or one specific one (column 2, row 2, for example). In a perfect world, users could then use the base that was created to do a mail merge to make many sheets of labels, but I’m afraid that may be asking too much.

Is this even possible? If it is, how would I start?
Thanks-
Karen

My current code:
Private Sub UserForm_Initialize()
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim myarray As Variant
Dim colcount As Long
Dim bstartApp As Boolean
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If xlapp Is Nothing Then
bstartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open("F:\BHBAFORM\office addresses.xls")
Set xlsheet = xlbook.Worksheets(1)
myarray = xlsheet.Range("A1").CurrentRegion.Value
colcount = xlsheet.Range("A1").CurrentRegion.Columns.Count
Set xlsheet = Nothing
xlbook.Close SaveChanges:=False 'close the book
Set xlbook = Nothing
If bstartApp = True Then
xlapp.Quit
End If
Set xlapp = Nothing
With cboOfficeAddress
.ColumnCount = colcount
.List = myarray
.RemoveItem (0) 'Remove the column headers
End With

cboOfficeAddress = cboOfficeAddress.Column(0, 0)

End Sub

Private Sub btnOK_Click()
Dim i As Long
i = cboOfficeAddress.ListIndex
If i > -1 Then
With ActiveDocument
.Variables("Address1").Value = cboOfficeAddress.List(i, 1)
.Variables("Address2").Value = cboOfficeAddress.List(i, 2)
.Variables("Address3").Value = cboOfficeAddress.List(i, 3)
.Variables("Address4").Value = cboOfficeAddress.List(i, 4)
.Variables("Contact1").Value = cboOfficeAddress.List(i, 5)
.Variables("Contact2").Value = cboOfficeAddress.List(i, 6)
.Variables("Contact3").Value = cboOfficeAddress.List(i, 7)
.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Fields.Update
End With

Else
MsgBox "Please select the office."
Exit Sub
End If
Unload Me
End Sub

Private Sub btnCancel_Click()
Unload Me
ActiveDocument.Close SaveChanges:=False

End Sub