Adressetiketten von Word zu Excel

[falkowi]

Hallo liebe Forumgemeinde,

schon oft habe ich mich hier durchs Forum geklickt, um schnell Antworten auf meine Fragen zu MS Office zu finden.

Doch dieses mal komme ich nicht mehr weiter. Nun habe ich mich registriert um euch meine (hoffentlich leicht zu beantwortende) Frage zu stellen.

Ich habe diverse Word Dateien, in diesen sind Adressetiketten welche ich in der Regel selbst ausgedruckt habe. Nun aber möchte ich diese von einer Druckerei direkt auf meine Briefe drucken. Dafür müssen die Adressdateien in eine Excelliste übertragen werden. 

Meine Frage ist, wie ich dieses automatisieren kann, ohne jede Adresse einzeln in die Adressfelder zu kopieren.

Anbei sende ich die beiden Dateien zur Veranschaulichung.

Ich freue mich über jede Antwort!

Viele Grüße
Falko


  Vorlage_Adressdatei.xls (Größe: 30 KB / Downloads: 10)


  Adressetiketten-Muster.doc (Größe: 34,5 KB / Downloads: 11)

[Jockel]

gelöscht. ich hatte die Druckerei übersehen... sorry

[Fennek]

Hallo,

mit folgendemCode werden die Adressen im Word-Dokument gelesen. Damit ist ein Umwandlung in das gewünschte Format und die Übertragung nach Excle möglich.

Code:

Sub T_1()
Debug.Print ThisDocument.Tables(1).Columns.Count, ThisDocument.Tables(1).Rows.Count
With ThisDocument.Tables(1)
  For i = 1 To .Rows.Count
       For j = 1 To .Columns.Count Step 2
           Debug.Print .Cell(i, j).Range.Text
       Next j
   Next i
End With
End Sub

Frage: Gibt es viele Dateien mit jeweils 1 Seite oder weniiger Dateien mit mehreren Seiten? Liegen die in einem Ordner?

mfg

[falkowi]

Frage: Gibt es viele Dateien mit jeweils 1 Seite oder weniiger Dateien mit mehreren Seiten? Liegen die in einem Ordner?

mfg

Hallo Fennek,

vielen Dank für die Antwort! Es sind aktuell 45 Word Dateien mit jeweils einer Seite welche in einem Ordner liegen. Diese könnte man ja aber sicherlich einfach zusammenfügen.

Das mit dem Code habe ich ehrlich gesagt noch nicht ganz verstanden   Würde mich über eine kurze Erklärung sehr freuen.

[Fennek]

Hallo,

gut, ist ist kein Problem nacheinander die *.doc Dateien eines Ordners auszulesen.

Dann bleibt die zentrale Frage: In Excel müssen die Adressen einzelnen Zellen zuwiesen werden: Ist die Struktur des gezeigten Beispiels für ALLE Adressen identisch?

mfg

(ich hoffe, dass du Grundkenntnisse in VBA hast)

[falkowi]

Dann bleibt die zentrale Frage: In Excel müssen die Adressen einzelnen Zellen zuwiesen werden: Ist die Struktur des gezeigten Beispiels für ALLE Adressen identisch?

(ich hoffe, dass du Grundkenntnisse in VBA hast)

Die Struktur ist immer gleich. Lediglich fehlen (leider) bei einigen Adressen die Vornamen. Oftmals steht also nur der Nachname in der Word Datei. Aber dieses könnte ich auch später händisch abändern.

Ich bin leider kein Programmierer. Grundkenntnisse in Excel sind vorhanden und ich bin lernbereit Ich hoffe es ist keine zu komplizierte Sache...

[Fennek]

Hallo,

der Code liest alle Etiketten einer Datei in ein Array (das später nach xl übertragenwird)

Teste den Code bitte im Einzelschrittmodus F8.

Code:

Type Adresse
   Gender  As String
   VorNm   As String
   NachNm  As String
   Str     As String
   Nr      As Integer
   PLZ     As String
   Stadt   As String
End Type


Sub T_1()
Dim Adr(1000) As Adresse

With ThisDocument.Tables(1)
  For i = 1 To .Rows.Count
       For j = 1 To .Columns.Count Step 2
           Tx = Split(.Cell(i, j).Range.Text, Chr(13))
           Adr(a).Gender = Trim(Tx(0))
           Adr(a).NachNm = Trim(Tx(1))
           Adr(a).Str = Trim(Tx(2))
           Adr(a).PLZ = Split(Trim(Tx(3)))(0)
           Adr(a).Stadt = Split(Trim(Tx(3)))(1)
       Next j
       a = a + 1
   Next i
End With
End Sub

Wenn du die Maus über z.B. Adr(a).Gender fährst, wird der aktuelle Wert gezeigt.

Wenn alles passt folgt die Übertragung nach xl, im 1. Test für eine Doc-Datei, danach dann für alle.

mfg

[snb]

Makro in Excel:

Code:

Sub M_snb()
   With GetObject("G:\OF\adressetiketten_001.docx")
      sn = Split(.Content, Chr(7) & vbCr)
      .Close 0
   End With
   
   For j = 0 To UBound(sn)
     st = Split(sn(j), vbCr)
     sheets(1).Cells(Rows.Count, 1).End(xlup).Offset(1).Resize(, UBound(st) + 1) = st
   Next
End Sub

[falkowi]

der Code liest alle Etiketten einer Datei in ein Array (das später nach xl übertragenwird)

Teste den Code bitte im Einzelschrittmodus F8.

Wenn du die Maus über z.B. Adr(a).Gender fährst, wird der aktuelle Wert gezeigt.

Wenn alles passt folgt die Übertragung nach xl, im 1. Test für eine Doc-Datei, danach dann für alle.

Erst einmal besten Dank!

Ist es möglich mir die Schritte als absoluten Anfänger noch zu erklären? Oder finde ich hier im Forum eine Anleitung?

Habe gerade etwas rumprobiert. Bin in der Word Datei auf Extras -> Macro -> Visual Basic Editor 
Soweit richtig?

Danach öffnet sich dann ein Fenster mit "Projekt" anbei ein Screenshot. 

Und dann wirds kompliziert, wo muss der Code eingefügt werden?
Ich habe es bei This Document probiert. Bekomme dann aber die Fehlermeldung "Fehler beim Kompilieren" Der benutzerdefinierte Typ "Puclic" kann in einem Objektmodul nicht definiert werden.
   

[Fennek]

Hallo,

so effizient wie snb bekomme ich das nicht hin:

Code:

Type Adresse
   Anrede  As String
   VorNm   As String
   NachNm  As String
   Str     As String
   Nr      As Integer
   PLZ     As String
   Stadt   As String
End Type

Sub T_1()
Dim Adr(1000) As Adresse
Dim Xl As Object: Set Xl = CreateObject("Excel.Application")
Dim WB As Object
With ThisDocument.Tables(1)
  For i = 1 To .Rows.Count
       For j = 1 To .Columns.Count Step 2
           Tx = Split(.Cell(i, j).Range.Text, Chr(13))
           Adr(a).Anrede = Trim(Tx(0))
           If InStr(1, Trim(Tx(1)), " ") > 0 Then
               Adr(a).VorNm = Split(Trim(Tx(1)))(0)
               Adr(a).NachNm = Split(Trim(Tx(1)))(1)
           Else
               Adr(a).NachNm = Trim(Tx(1))
           End If
           Adr(a).Str = Split(Trim(Tx(2)))(0)
           Adr(a).Nr = Split(Trim(Tx(2)))(1)
           Adr(a).PLZ = Split(Trim(Tx(3)))(0)
           Adr(a).Stadt = Split(Trim(Tx(3)))(1)
       Next j
       a = a + 1
   Next i
End With
Set WB = Xl.Workbooks.Add
Xl.Visible = True
With WB.sheets(1)
For i = 0 To a
   .Cells(i + 2, 3) = Adr(i).Anrede
   .Cells(i + 2, 5) = Adr(i).VorNm
   .Cells(i + 2, 6) = Adr(i).NachNm
   .Cells(i + 2, 7) = Adr(i).Str
   .Cells(i + 2, 8) = Adr(i).Nr
   .Cells(i + 2, 10) = Adr(i).PLZ
   .Cells(i + 2, 11) = Adr(i).Stadt
Next i
End With
Set Xl = Nothing
End Sub

Für die nächsten Stunden bin ich nicht am PC.

mfg

(dies ist ein Word-Makro)