Printing labels

[Dirk Desart]

I have a database in Exel with Names and adresses and I want to print labels
starting from word.
So far no problem.
In each record is a field with the number of labels there are to print from
that record.
How can I do this?

Thank for any help.

Dirk...

[Nick Hodge]

Dirk

I think you would only be able to do this by duplicating the records x
number of times, perhaps on another sheet. Code to achieve this should be
fairly simple, but we'd need to know the layout of the sheet.

--
HTH
Nick Hodge
Microsoft MVP - Excel
Southampton, England
nick_...@lineone.net

"Dirk Desart" <dirk.d...@pandora.be> wrote in message
news:czsq7.63597$6x5.13...@afrodite.telenet-ops.be...

[David McRitchie]

Hi Dirk, (posted with email copy)
If you need a macro to repeat rows to help create input for Mail Merge
the RepeatRowsOnColumnA macro will repeat based on Column A.
http://www.geocities.com/davemcritchie/excel/mailmerg.htm#multilabel

HTH,
David McRitchie, Microsoft MVP - Excel
My Excel Macros: http://www.geocities.com/davemcritchie/excel/excel.htm
Search Page: http://www.geocities.com/davemcritchie/excel/search.htm

"Nick Hodge" <nick_...@lineone.net> wrote in message news:eN0Z2ZhQBHA.1440@tkmsftngp04...

> I think you would only be able to do this by duplicating the records x
> number of times, perhaps on another sheet. Code to achieve this should be
> fairly simple, but we'd need to know the layout of the sheet.
>

[dirk desart]

Thank you Nick. As you said It works by duplicating the records.
I used the code from
http://www.geocities.com/davemcritchie/excel/mailmerg.htm#multilabel
and it did work.
What I like to know is. Can I start this routine from word.
Greetings,
Dirk...

"Nick Hodge" <nick_...@lineone.net> wrote in message news:<eN0Z2ZhQBHA.1440@tkmsftngp04>...

[dirk desart]

Thank you David. I used the code from
http://www.geocities.com/davemcritchie/excel/mailmerg.htm#multilabel
and it did work. I'm happy.
I'm wondering if it is possible to start this routine from Word.
Greetings,
Dirk
"David McRitchie" <dmcri...@msn.com> wrote in message news:<uFTX6UkQBHA.2140@tkmsftngp05>...

[Nick Hodge]

Dirk

Most things are possible. Below is code (Original property of David
McRitchie, with Word interactivity added) which if entered into a module in
Word, will allow you to open an XL file, structured as David's example. (No.
of occurrences in left most field etc.). It will run David's code on your
selected file and will save the data to a new book, so that the original
file is untouched. It then sets this new xl file as the data source for the
merge, using the active document.

As the code uses early binding, you will need to open the VBE in Word
(Alt+F11) and set a reference to the Microsoft Excel Object Library, by
using Tools>References...

Option Explicit
Sub RepeatRowsOnColumnA()
'Prepare multiple rows for Mail Merge labels
' based on number of labels in column A
'David McRitchie, programming, 2001-09-20
'Word interactivity added by Nick Hodge 23/9/2001
'So don't blame David...Code worked before I messed with it!

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlOpenFileName As String, xlCloseFileName As String

Set xlApp = New Excel.Application
xlOpenFileName = xlApp.GetOpenFilename("Microsoft Excel Workbooks, *.xls", ,
_
"Select the file to duplicate labels")
Set xlWB = xlApp.Workbooks.Open(xlOpenFileName)

xlWB.ActiveSheet.Copy Before:=xlWB.ActiveSheet
'xlApp.ScreenUpdating = False
Dim vRows As Long, v As Long
On Error Resume Next
Dim ir As Long, mrows As Long, lastcell As Excel.Range
Set lastcell = xlWB.ActiveSheet.Cells.SpecialCells(xlLastCell)
mrows = lastcell.Row
For ir = mrows To 2 Step -1
If Not IsNumeric(xlWB.ActiveSheet.Cells(ir, 1)) Then
xlWB.ActiveSheet.Cells(ir, 1).EntireRow.Delete
ElseIf xlWB.ActiveSheet.Cells(ir, 1).Value > 1 Then
v = xlWB.ActiveSheet.Cells(ir, 1).Value - 1
xlWB.ActiveSheet.Rows(ir + 1).Resize(v).Insert Shift:=xlDown
xlWB.ActiveSheet.Rows(ir).EntireRow.AutoFill xlWB.ActiveSheet.Rows(ir). _
EntireRow.Resize(rowsize:=v + 1), xlFillCopy
'xlWB.ActiveSheet.Rows(ir).EntireRow.Interior.ColorIndex = 36
ElseIf xlWB.ActiveSheet.Cells(ir, 1).Value < 1 Then
xlWB.ActiveSheet.Cells(ir, 1).EntireRow.Delete
End If
Next ir
'xlApp.ScreenUpdating = True
xlWB.ActiveSheet.Move
MsgBox "Your original data will not been changed, save the new file under a
different name", vbOKOnly
xlCloseFileName = xlApp.GetSaveAsFilename(, "Microsoft Excel
Workbooks,*.xls", , _
"Save the new file with duplicate records")

xlWB.Close False
Set xlWB = xlApp.ActiveWorkbook
xlWB.Close True, xlCloseFileName
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing
ActiveDocument.MailMerge.OpenDataSource xlCloseFileName
End Sub

--
HTH
Nick Hodge
Microsoft MVP - Excel
Southampton, England
nick_...@lineone.net

"dirk desart" <dirk....@pi.be> wrote in message
news:a6d732d9.01092...@posting.google.com...

[dirk desart]

Nick, thank you for the code. I still have to try it out and try to
fit in my application.
Greetings?
Dirk

"Nick Hodge" <nick_...@lineone.net> wrote in message news:<uncZn$BRBHA.2080@tkmsftngp03>...