Hi Alex,

Wer wird denn gleich so schnell aufgeben? Dass es sich bei den Bildern um QR-Codes handelt ist eine wichtige Info die du uns mal eben einfach verschwiegen hast. Das macht die Sache natürlich viel einfacher. Und natürlich kannst du das Ganze auch nebeneinander darstellen. Probier mal den folgenden Code in Word und berichte. Den Pfad musst du natürlich genauso anpassen, wie den Taebellennamen des Excel-Blattes im SQL-Statement.

Außerdem kann es sein, dass deine Felder nicht "Datei" und "Name" sondern anders heißen. In dem Fall auch die Feldnamen im Code anpassen.

Sub Etikett_Erstellen()
  Dim doc As Document, cl As Cell, i As Long
  Set doc = Application.MailingLabel.CreateNewDocumentByID(LabelId:="805957182")
  doc.MailMerge.OpenDataSource Name:="D:\Pfad\SerienNames.xlsx", SQLStatement:="SELECT * FROM `Tabelle1$`"
  ActiveWindow.View.ShowFieldCodes = True
  For z = 1 To 8
    For s = 1 To 5 Step 2
      Set cl = doc.Tables(1).Cell(z, s)
        With cl.Tables.Add(Range:=cl.Range, NumRows:=1, NumColumns:=2)
          For i = 1 To 8
            .Borders(-i).LineStyle = wdLineStyleNone
          Next i
          .TopPadding = CentimetersToPoints(0)
          .BottomPadding = CentimetersToPoints(0)
          .LeftPadding = CentimetersToPoints(0)
          .RightPadding = CentimetersToPoints(0)
          .Spacing = 0
          .Rows.HeightRule = wdRowHeightExactly
          .Rows.Height = cl.Height
          doc.Fields.Add Range:=StartRange(.Cell(1, 1).Range), Text:="DISPLAYBARCODE ""Hier"" QR"
          doc.MailMerge.Fields.Add Range:=PartRange(.Cell(1, 1).Range, "Hier"), Name:="Datei"
          doc.MailMerge.Fields.Add Range:=.Cell(1, 2).Range, Name:="Datei"
          EndRange(.Cell(1, 2).Range).InsertAfter vbNewLine
          doc.MailMerge.Fields.Add Range:=EndRange(.Cell(1, 2).Range), Name:="Name"
          .Cell(1, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
          .Cell(1, 1).VerticalAlignment = wdCellAlignVerticalCenter
          .Cell(1, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
          .Cell(1, 2).VerticalAlignment = wdCellAlignVerticalCenter
          If Not (z = 1 And s = 1) Then doc.Fields.Add Range:=StartRange(.Cell(1, 1).Range), Text:="NEXT "
        End With
        'Stop
    Next s
  Next z
  
  ActiveDocument.MailMerge.Destination = wdSendToNewDocument
  ActiveDocument.MailMerge.Execute Pause:=False
  ActiveWindow.View.ShowFieldCodes = False
End Sub

Function EndRange(rng As Range) As Range
  Dim myRange As Range
  Set myRange = rng
  myRange.SetRange rng.End - 1, rng.End - 1
  Set EndRange = myRange
End Function
Function StartRange(rng As Range) As Range
  Dim myRange As Range
  Set myRange = rng
  myRange.SetRange rng.Start, rng.Start
  Set StartRange = myRange
End Function
Function PartRange(rng As Range, LookFor As String) As Range
  'Stop
  Dim myRange As Range, s As Long, e As Long
  Set myRange = rng
  s = InStr(myRange, LookFor)
  e = s + Len(LookFor)
  myRange.SetRange rng.Start + s - 1, rng.Start + e - 1
  Set PartRange = myRange
End Function

Gruß Mr. K.