VBA für Etikettendruck - Fehlermeldung 5194
07.04.2026 22:58:39
Shanna
vorweg: Ich habe fast keine Ahnung von VBA...
Im leider nicht mehr existierenden MS-Office-Forum.net hatte ich vor ein paar Jahren einen Beitrag gefunden, den ich für meine Zwecke bisher gut benutzen konnte.
Und jetzt funktioniert es nicht mehr und ich weiß nicht warum.
Änderungen bei mir:
neuer Rechner, Windows 11.
Aufgabenstellung:
DIN-A 4 Etikettenvorlagen in immer wieder anderer Zusammenstellung drucken.
Also mal wird die Etikettennummer 25 gleich 23 x benötigt, mal nur 5 x.
Also Exceltabelle mit zwei Spalten, einmal die Beschriftung des Etiketts, die andere Spalte mit der Anzahl der gewünschten Etiketten.
Wenn ich jetzt die Worddatei mit den automatischen Makros nutze, dann kommt für das Makro 2 folgende Fehlermeldung:
Laufzeitfehler '5941':
Das angeforderte Element ist nicht in der Sammlung vorhanden.
Im Code ist diese Angabe farbig hinterlegt:
anzZeilen = ActiveDocument.Tables(1).Columns.Count
Gerne kann ich die beiden Makrotexte einstellen.
Makro 1:
Option Explicit
Dim artikelDaten As Variant
Dim letzteZeile As Long, letzteSpalte As Long
Private Sub document_new()
datenEinlesen
datenUebertragen
End Sub
Sub datenEinlesen()
Dim excelmappe As Object, excelinstanz As Object, excelsheet As Object
Dim datei As String
Dim i As Long, j As Long
On Error GoTo fehler
'Excel-Mappe öffnen
Set excelinstanz = CreateObject("Excel.application")
excelinstanz.Visible = True 'kann später, wenn alles funktioniert, auf False gesetzt werden
datei = ThisDocument.Path & "\datenquelle.xlsx" '**Name der Excelmappe anpassen
Set excelmappe = excelinstanz.workbooks.Open(FileName:=datei)
Set excelsheet = excelmappe.sheets("tabelle1") '**Tabellenblattname anpassen
'letzte Zeile / letzte Spalte feststellen
With excelsheet
letzteZeile = .Cells(.Rows.Count, 1).End(-4162).Row
letzteSpalte = .Cells(1, .Columns.Count).End(-4159).Column
artikelDaten = .Range(.Cells(2, 1), .Cells(letzteZeile, letzteSpalte))
End With
'Ecelmappe schließen:
excelmappe.Close savechanges:=False
excelinstanz.Visible = True
excelinstanz.Quit
Set excelinstanz = Nothing
Set excelmappe = Nothing
Exit Sub
fehler:
MsgBox Err.Description & " - " & Err.Number
excelinstanz.Visible = True
excelinstanz.Quit
Set excelinstanz = Nothing
Set excelmappe = Nothing
End Sub
Makro 2:
Sub datenUebertragen()
Dim i As Long, j As Long, z As Long
Dim anzZeilen As Long, aktZeile As Long, anzEti As Long
anzZeilen = ActiveDocument.Tables(1).Columns.Count
For i = 1 To letzteZeile - 1
anzEti = artikelDaten(i, letzteSpalte)
For j = 1 To anzEti
z = z + 1
aktZeile = aktZeile + 1
If aktZeile > anzZeilen Then
ActiveDocument.Tables(1).Rows.Add
aktZeile = 1
End If
With ActiveDocument.Tables(1).Range.Cells(z).Range
.Paragraphs(1).Range = artikelDaten(i, 1) & vbLf
End With
Next j
Next i
End Sub
Ich bin so langsam verzweifelt... 🤷♀️
Wer kann mir bitte helfen? Ganz lieben Dank im Voraus...
VG, Shanna
Dies ist die Excel-Datei:
https://www.herber.de/bbs/user/180496.xlsx
Die Word-Datei mit den Makros kann ich leider nicht hochladen... Sie besteht aus einer Tabellenzeile (je nach Etikettenvorlage gestaltet) und erweitert sich Spalte um Spalte automatisch - je nach Datenquelle:
Anzeige
