Etikettentricks

Aus einer Excel-Adressliste sollten Adressetiketten generiert werden. Bei einigen Kunden sind aber 2, 3 oder mehr gleiche Etiketten auszudrucken. Gibt es eine Möglichkeit, Word zu sagen, dass es vier Etiketten drucken soll, wenn in Excel in der Spalte x die Zahl 4 steht?

D. GANTENBEIN, UNTERSTAMMHEIM

Diese Aufgabenstellung lässt sich über ein Excel-Makro lösen. Das Progrämmchen durchläuft die Adressliste und überprüft die Angabe der Excel-Spalte, welche die Zahl der zu druckenden Etiketten enthält (im Beispiel ist das die dritte Spalte, also «C»). Steht dort ein Wert höher als 1, wird die entsprechende Zeile so oft kopiert, wie Etiketten benötigt werden. Um die ursprünglichen Daten nicht zu verändern, kopiert das Makro die Daten in ein separates Arbeitsblatt namens «Serienbrief-Export». Dieses können Sie speichern und für den Seriendruck in Winword verwenden. Sind die Etiketten erstellt, löschen Sie es, denn das Makro arbeitet nicht, wenn ein Export-Arbeitsblatt vorhanden ist.

Ggf. müssen Sie den Wert anpassen, der vorgibt, in welcher Spalte die Anzahl Etiketten zu finden ist. Dies betrifft die Codezeile «AnzEtt = Cells(i, 3).Value». Wenn das bei Ihnen die Spalte «G» (also die 7. Spalte) sein sollte, ersetzen Sie die Drei durch eine Sieben.

Sie können das Makro herunterladen:
www.tages-anzeiger.ch

SCREEN TA

Wenige Zeilen für mehr Etiketten.

---

Der Code des Makro

Öffnen Sie über «Extras > Makro > Makros» das entsprechende Dialogfeld, geben Sie unter «Makroname» die Bezeichnung des Progrämmchens ein, also «Mehrere_Etiketten», und klicken Sie auf die Schaltfläche «Erstellen». Kopieren Sie dann den nachfolgenden Code in das Makrofenster. Anschliessend können Sie das Makro über den gleichen Menübefehl aufrufen.

Sub Mehrere_Etiketten()
'
' Mehrere_Etiketten Makro
' Mehrere Adressetiketten ausgeben

    Cells.Select
    Selection.Copy
    Sheets.Add
    ActiveSheet.Paste
    ActiveSheet.Name = "Serienbrief-Export"
    For i = Columns.Count To 2 Step -1
        AnzEtt = Cells(i, 3).Value
        If AnzEtt > 1 Then
            Rows(i).Select
            Application.CutCopyMode = False
            For y = 2 To AnzEtt
                Selection.Copy
                Selection.Insert Shift:=xlDown
                Next y
            End If
        Next i
End Sub