Macro plaatst slechts 1 etiket op elk vel (A4'je)

[Johil]

Beste mensen
Word 2011.
Handmatig of met de wizard lukt het prima om vanuit Excel de gegevens op de etiketten te zetten (15 etiketten op 1 A4).
Die handelingen heb ik opgenomen als macro.
Zodra de macro is opstart zet hij slechts 1 etiket per 1 A4. Geen foutmelding.
Iemand enig idee waar dit gezocht moet worden.
Alvast met dank.
groet
Joop

 

[OctaFish]

Het helpt behoorlijk als je de macro code meeplaatst, dan kunnen we zien wat er precies gebeurt.
Als je de code plakt, dan graag opmaken met de CODE knop ( Knop # ) in het Gevanceerde editor scherm te vinden.

 

[Johil]

Beste mensen.
Inderdaad kun je MET code e.e.a. veel beter analyseren.
Aldus bijgevoegd.
M.b.v. de wizard zijn de etiketten op het A4'je geplaatst. De macro heeft deze handelingen opgenomen.
Als ik de macro uitvoer wordt 1 etiket per A4'je geplaatst.
Hopelijk kan iemand de oorzaak achterhalen of een tip geven.
Met dank alvast.
groet
Joop

Sub BernsEtiketten()
'
' BernsEtiketten Macro
'
'
    ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
    ActiveDocument.MailMerge.OpenDataSource Name:="C:\Temp\Berns.xlsx", _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Temp\Berns.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Glo" _
        , SQLStatement:="SELECT * FROM `Etiketten$`", SQLStatement1:="", SubType _
        :=wdMergeSubTypeAccess
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""Alle_Etiketten"""
    ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
        , Text:="""Alle_Prijzen"""
    Selection.MoveLeft Unit:=wdCharacter, Count:=14
    Selection.TypeParagraph
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
End Sub