Ich pflege meine Adressen mit Excel (einige Macros machen es recht bequem). Eine Auswahl möchte ich mit Word ausdrucken (Etiketten). Ich möchte Word mittels Macro aus Excel starten und dort den Druckvorgang automatisch erledigen.
Im Excel kann man ein Word-Fenster zwar einbetten (Einfügen, Objekt, Microsoft Word Dokument, ...), aber der Funktionsumfang ist eingeschränkt (z.B. Serienbriefe gehen nicht).
Wie kann man aus Excel Word starten?
Uli M Excel-Freund „Wie kann man aus Excel Word starten?“
Mach dies besser von Word aus (z.B. Seriendruck) und wähle deine Excel-Tabelle als Datenquelle. Natürlich lässt sich dasselbe Ergebnis auch programmieren (von beiden Seiten aus oder ggf. auch nur in Excel), wobei es dann empfehlenswert wäre, eine bereits zugeschnittenen Vorlage einzusetzen (üblicherweise Word-Tabelle mit den richtigen Maßen für die gewünschten Etiketten - auch hierzu kann in Word der entspr. Assi genutzt werden).
Sub EtikettenDrucken()
Const ksTitel = "Etiketten drucken"
Const ksDot = "c:\Etiketten1.dot"
Dim oRange As Range
Dim Y As Integer, S As String
Dim oAppWd As Object, oDocWd As Object
Dim oTableWd As Object, oCellWd As Object
If Dir(ksDot) = "" Then
MsgBox "Etikettenvorlage " & Chr(34) & ksDot & Chr(34) & " nicht gefunden!", vbExclamation, ksTitel
Exit Sub
End If
Set oAppWd = CreateObject("Word.Application")
' oAppWd.Visible = True ' bei Bedarf
oAppWd.DisplayAlerts = 0 ' bei Bedarf
Set oDocWd = oAppWd.Documents.Add(ksDot)
Set oTableWd = oDocWd.Tables(1)
Set oCellWd = oTableWd.Cell(1, 1)
' ggf. Markierung checken
' hier wird davon ausgegangen, dass die Spalten A - E die folgenden Daten beinhalten:
' Name Vorname Strasse Plz Ort => ggf. anpassen
Set oRange = Selection
For Y = 1 To oRange.Rows.Count
S = ""
' bei der Word-Tabelle wird u.a. davon ausgegangen, dass _
sie linear ist (alle Zeilen gleiche Spaltenanzahl, keine verbundenen Zellen, keine Trennzellen existieren) _
sie wird bei Bedarf erweitert
' spez. Formatierung bei Bedarf zusätzlich einbauen (dann event. nicht mit GesamtString arbeiten bzw. schon in der Vorlage
S = oRange.Cells(Y, 2)
If S "" Then S = S & " " ' Sonderbehandlung fehlender, hier nur Vorname
S = S & oRange.Cells(Y, 1) & Chr(13)
S = S & oRange.Cells(Y, 3) & Chr(13)
S = S & Chr(13) & oRange.Cells(Y, 4) & " " & oRange.Cells(Y, 5)
oCellWd.Range.Text = S
Set oCellWd = oCellWd.Next
If oCellWd Is Nothing Then
oTableWd.Rows.Add
Set oCellWd = oTableWd.Cell(oTableWd.Rows.Count, 1)
End If
Next Y
oDocWd.PrintOut Background:=False
oAppWd.DisplayAlerts = -1 ' s.o.
oAppWd.Quit 0
mEnd:
Set oDocWd = Nothing
Set oAppWd = Nothing
End Sub
