Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Word Texte und Tabellen in Excel kopieren

Word Texte und Tabellen in Excel kopieren
24.02.2017 14:47:08
Urs
Hallo
Ich bin schon seit längerer Zeit daran in einem geschützten Word-Dokument Texte und Zahlen, die der User eingibt, in ein Excel pro Zeile zu schreiben. Was ich bereits habe, ist ein Makro, dass die ContentControls in einer MsgBox bringt. Ich müsste einfach anstelle der MsgBox die Einträge in eine externe Excel-Date beginnt in A1,A2,A3....bis Dokumentende.
Da von den Usern verschiedene Worddokumente ausgefüllt werden, gibt es im Excel pro Zeile einen Eintrag.
Wäre schön, wenn ich da weiterkommen könnte. Vielen Dank.

Sub Test()
Dim arrfelder() As Variant
Dim sPfad As String
Dim iCounter As Integer
Dim Zelle As Range
'Pfad
sPfad = "H:\Makros\Leistungsanalyse\"
'Dateiname
sFile = "LEH_doku.xlsx"
With ActiveDocument
'Felder der Reihe nach einlesen
For i = 1 To .ContentControls.Count
ReDim Preserve arrfelder(i)
arrfelder(i) = .ContentControls(i).Range.Text
Next i
End With
For i = 1 To UBound(arrfelder)
MsgBox arrfelder(i)
Next i
End Sub


22
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: nur ein Ansatz
24.02.2017 15:24:38
Fennek
Hallo,
da ich das nicht nachbauen und testen möchte, nur ein Ansatz:
"arrfelder" scheint ein 1-dim Array zu sein

Sub Test()
Dim arrfelder() As Variant
Dim sPfad As String
Dim iCounter As Integer
Dim Zelle As Range
'Pfad
sPfad = "H:\Makros\Leistungsanalyse\"
'Dateiname
sFile = "LEH_doku.xlsx"
With ActiveDocument
'Felder der Reihe nach einlesen
For i = 1 To .ContentControls.Count
ReDim Preserve arrfelder(i)
arrfelder(i) = .ContentControls(i).Range.Text
Next i
End With
'neu: xlsx-Datei: Summary existiert
set WS = createobject("c:\temp\Summary.xlsx")
WS.sheets(1).cells(1) = application.transpose(arrfelder)
WS.close 1
For i = 1 To UBound(arrfelder)
MsgBox arrfelder(i)
Next i
End Sub
Berichte doch mal, ob es so oder so ähnlich klappt.
mfg
Anzeige
AW: nur ein Ansatz
24.02.2017 15:48:41
Urs
Hallo Fennek
Danke für die Hilfe.
Bekomme ein Kompillierfehler bei "transpose" "Methode oder Datenobjekt nicht gefunden".
Zur Erinnerung, der VBA Code ist im Word, nicht im Excel!
habe auch ne halbe h gebastelt:
24.02.2017 15:51:49
Michael
Hi,
das redim Preserve kostet unnütze Zeit: einfach vorher ReDimen:
Sub Test()
Dim arrfelder() As Variant
Dim sPfad As String, sDatei As String
Dim oEx As Object
Dim i As Long
sPfad = "C:\A_Forum_DL\"      ' an Deine Bedürfnisse anpassen
sDatei = "ImportAusWord.xlsx" ' an Deine Bedürfnisse anpassen
With ActiveDocument
ReDim arrfelder(1 To .ContentControls.Count, 1 To 1)
For i = 1 To .ContentControls.Count
arrfelder(i, 1) = .ContentControls(i).Range.Text
Next i
End With
For i = 1 To UBound(arrfelder)
MsgBox arrfelder(i, 1)
Next i
Stop ' diese Zeile dann wieder rausnehmen
Set oEx = CreateObject("excel.application").Workbooks.Open(sPfad & sDatei)
oEx.sheets(1).Range("A1").Resize(i - 1, 1) = arrfelder
oEx.Save
oEx.Close
Set oEx = Nothing
End Sub

Das Skript enthält einige "Gemeinheiten":
a) das Array arrfelder ist *zweidimensional* ge-redim-t, weil man die in einem Rutsch in ein Tabelle schreiben kann und
b) gerade bei diesem Vorgang nehme ich beim .resize(i-1,1), weil i nach der For-Schleife 1 höher ist als die To-Angabe.
Schöne Grüße,
Michael
Anzeige
AW: habe auch ne halbe h gebastelt:
24.02.2017 16:10:58
Urs
Hallo Michael
Perfekt.....danke. Hat nur ein Schönheitsfehler, schreibt mir die Elemente unterhalb, anstelle von A1-Axxx? Wenn du das noch lösen könntest, wäre toll.
Bereits jetzt schon vielen Dank, auch an Fennek für die Hilfe.
verstehe ich jetzt nicht,
24.02.2017 16:29:42
Michael
Urs,
was heißt "unterhalb"? Bei meinen Tests war's von A1-An.
Du wolltest doch alles in (einer) Spalte A?
Gruß,
M.
AW: verstehe ich jetzt nicht,
24.02.2017 16:37:56
Urs
Hallo Michael
oh backe..... Da habe ich richtig gedacht aber falsch geschrieben. Ich müsste in A1, B1 C1....
Sorry.
AW: verstehe ich jetzt nicht,
24.02.2017 16:55:56
Urs
Hallo Michael
Ich möchte nicht alles in einer Spalte sondern Text1 in Zelle A1, Text2 in Zelle B1 usw....
Bei einem weiteren Dokument dann in Zelle A2, B2....usw. Aber das kann ich dann noch selber einbauen.
Gruss
Urs
Anzeige
na dann
25.02.2017 12:45:13
Michael
Hi Urs,
eine Möglichkeit ist, einfach die Indexe auszutauschen:
Sub TestQuer()
Dim arrfelder() As Variant
Dim sPfad As String, sDatei As String
Dim oEx As Object
Dim i As Long
sPfad = "C:\A_Forum_DL\"
sDatei = "ImportAusWord.xlsx"
With ActiveDocument
ReDim arrfelder(1 To 1, 1 To .ContentControls.Count) ' ***
For i = 1 To .ContentControls.Count
arrfelder(1, i) = .ContentControls(i).Range.Text ' ***
Next i
End With
For i = 1 To UBound(arrfelder, 2) ' ***
MsgBox arrfelder(1, i)         ' ***
Next i
Stop ' diese Zeile dann wieder rausnehmen
Set oEx = CreateObject("excel.application").Workbooks.Open(sPfad & sDatei)
oEx.sheets(1).Range("A1").Resize(1, i - 1) = arrfelder ' ***
oEx.Save
oEx.Close
Set oEx = Nothing
End Sub
Eine weitere, das ganze Ding allgemein zu gestalten:
Sub testallgAufrufen()
Call TestAllg("d3", "quer", "C:\A_Forum_DL\ImportAusWord.xlsx")
Call TestAllg("h5", "hoch", "C:\A_Forum_DL\ImportAusWord.xlsx")
End Sub
Sub TestAllg(r As String, wie As String, sPfadUndDatei As String)
Dim arrfelder() As Variant, a2
Dim oEx As Object
Dim i As Long
With ActiveDocument
ReDim arrfelder(1 To 1, 1 To .ContentControls.Count)
For i = 1 To .ContentControls.Count
arrfelder(1, i) = .ContentControls(i).Range.Text
Next i
End With
If wie = "hoch" Then
a2 = arrfelder
ReDim arrfelder(1 To UBound(a2, 2), 1 To 1)
For i = 1 To UBound(arrfelder): arrfelder(i, 1) = a2(1, i): Next
For i = 1 To UBound(arrfelder)
MsgBox arrfelder(i, 1)
Next i
Else
For i = 1 To UBound(arrfelder, 2)
MsgBox arrfelder(1, i)
Next i
End If
Set oEx = CreateObject("excel.application").Workbooks.Open(sPfadUndDatei)
If wie = "hoch" Then
oEx.sheets(1).Range(r).Resize(UBound(arrfelder), 1) = arrfelder
Else
oEx.sheets(1).Range(r).Resize(1, UBound(arrfelder, 2)) = arrfelder
End If
oEx.Save
oEx.Close
Set oEx = Nothing
End Sub

Hier kannst Du die Zelle eingeben, ab der geschrieben werden soll, bei wie=hoch wird von A1:An geschrieben, ansonsten nach rechts.
Zeilenweise könntest Du es dann z.B. so aufrufen:
Dim z as Long
for z=1 to 3
' hier Deine Anweisungen, z.B. Laden einer anderen Word-Datei
' die wäre dann das jeweils neue ActiveDocument
Call TestAllg("A" & z, "quer", "C:\A_Forum_DL\ImportAusWord.xlsx")
next

"A" & z ist dann jeweils A1, A2 usw.
Schöne Grüße,
Michael
Anzeige
AW: Super
27.02.2017 09:16:27
Urs
Hallo Michael
Die Variante TestQuer hilft mir extrem, die andere brauch ich eigentlich nicht, ist aber auch hilfreich.
An dieser Stelle möchte ich mich ganz herzlich bei dir bedanken für die Hilfe.
Vielleicht wieder einmal, schöne Zeit.
Gruss
Urs
AW: Super
27.02.2017 13:41:45
Urs
Habe mich zu schnell verabschiedet. Habe geglaubt, dass ich den Rest selber noch hinkriege. Ist leider nicht so.
Das mit dem Hinzufügen eines neuen Dokumentes und den dazugehörigen Eintrag in das Excel File klappt bei mir nicht. Damit wir uns verstehen; Jedes Mal wenn ein neues Dokument eingelesen wird muss im Excel eine neue Zeile erzeugt werden und zwar in die untenstehende leere Zeile. Der Code im Excel habe ich schon öfters angewandt aber aus dem Word heraus weiss ich nicht wie.
Der Code sieht im Moment so aus:
Sub Test()
For z = 1 To 1
Call TestAllg("A" & z, "", "H:\Makros\Leistungsanalyse\LEH_doku.xlsx")
Next
End Sub
Sub TestAllg(r As String, wie As String, sPfadUndDatei As String)
Dim arrfelder() As Variant
Dim oEx As Object
Dim i As Long
With ActiveDocument
ReDim arrfelder(1 To 1, 1 To .ContentControls.Count)
For i = 1 To .ContentControls.Count
arrfelder(1, i) = .ContentControls(i).Range.Text
Next i
End With
Set oEx = CreateObject("excel.application").Workbooks.Open(sPfadUndDatei)
oEx.sheets(1).Range(r).Resize(1, UBound(arrfelder, 2)) = arrfelder
oEx.Save
oEx.Close
Set oEx = Nothing
End Sub

Anzeige
Schleife in Word?
27.02.2017 16:11:04
Michael
Hi,
im Prinzip wird der Aufruf von einer (sicher bereits vorhandenen) Schleife vorgenommen, die die gewünschten Word-Dokumente durchläuft.
Ich hatte ja bereits gepostet:
Dim z as Long
for z=1 to 3
' hier Deine Anweisungen, z.B. Laden einer anderen Word-Datei
' die wäre dann das jeweils neue ActiveDocument
Call TestAllg("A" & z, "quer", "C:\A_Forum_DL\ImportAusWord.xlsx")
next
DIE Funktionalität muß in Deine Schleife rein, also in normalen Worten etwa so:
Sub Einlesen
Dim z as Long
' Hier Pfad mit Word-Dateien wählen usw., dann
z = 0 ' oder 1 oder wie auch immer
For jedes_einzelne_Worddokument
öffne Dokument ' damit ist es "aktiv"
z = z + 1
Call TestAllg("A" & z, "", "H:\Makros\Leistungsanalyse\LEH_doku.xlsx")
Next
End Sub
Der Nachteil ist zweifellos, daß auf die Weise besagte Exceldatei pro Word-Datei je einmal geöffnet und wieder geschlossen wird - ach was, Excel selbst wird jedesmal geöffnet und geschlossen.
Bei 10 Dateien isses wurscht, bei 1000 wird's zäh...
Ich wüßte schon noch was Anderes, aber bitte poste mal besagte Word-Schleife zum Dateien einlesen: da mag ich jetzt nicht groß recherchieren.
Wenn ich die Schleife habe, ist es kein Problem, "das Excel" einzubauen.
Schöne Grüße,
Michael
Anzeige
So geht's jetzt
28.02.2017 14:07:58
Michael
Hi,
ich habe doch mal etwas Word-VBA recherchiert.
Insgesamt und mit nur *einem* Zugriff auf Excel funktioniert es so:
Option Explicit
Sub DateinImPfad()
'Quelle:
'http://www.ms-office-forum.net/forum/showthread.php?t=266560
'Dim wrdDoc As Document wegen With nicht benötigt
Dim wPfad As String, xPfad As String   ' Word- und Excel-Pfad
Dim wDatei As String, xDatei As String ' Word- und Excel-Dateiname
Dim dirDatei As String                 ' Dateiname für Dir-Befehl
Dim a(), b(), i&, aMax&, j&
Dim o As Object, oo
wPfad = "C:\A_Forum_DL\"
xPfad = "C:\A_Forum_DL\"
xDatei = "ImportAusWord.xlsx"
wDatei = "ImportAusWord_D"
dirDatei = Dir(wPfad & wDatei & "*.docx")
If dirDatei  "" Then Set o = CreateObject("scripting.dictionary")
Do While dirDatei > ""
With Documents.Open(wPfad & dirDatei, ReadOnly:=True)
MsgBox .Name & " wurde geöffnet" ' ggf auskommentieren
ReDim a(1 To 1, 1 To .ContentControls.Count) ' ***
For i = 1 To .ContentControls.Count
a(1, i) = .ContentControls(i).Range.Text ' ***
Next i
.Close
End With
o(dirDatei) = a   ' die eingelesene Zeile im dictionary gespeichert
If UBound(a, 2) > aMax Then aMax = UBound(a, 2)
' die höchste Spaltenanzahl ermitteln
dirDatei = Dir
Loop
Stop
If o.Count >= 1 Then
ReDim a(1 To o.Count, 0 To aMax)
i = 0
For Each oo In o.keys
i = i + 1
a(i, 0) = oo
b = o(oo)
For j = 1 To UBound(b, 2)
a(i, j) = b(1, j)
Next
Next
With CreateObject("excel.application").Workbooks.Open(xPfad & xDatei)
MsgBox .Name & ": " & UBound(a) & " Zeilen übernommen."
.sheets(1).Range("A2").Resize(i, aMax + 1) = a ' ab A2 wegen evtl. Überschriften
' aMax + 1, weil a ab (0,xx) dimensioniert: Spalte 0 enthält den Dateinamen
.Save
.Close
End With
Set o = Nothing
Else
MsgBox "keine Datein gefunden"
End If
End Sub

Die Pfade und den Dateifilter für die Word-Dokumente (wDatei) mußt Du halt anpassen.
Ich habe mich zur Verwendung eines Dictionaries entschlossen: das bietet sich deshalb an, weil man zunächst nicht weiß, wie viele Word-Dateien gelesen werden. Mit einem Array müßte man "ewig" ein Redim Preserve machen, was Zeit kostet: außerdem ist nicht auszuschließen, daß eine der Wort-Datei mehr Controls enthält als die anderen: auch das ist ein Hindernis bei der Dimensionierung von Arrays.
Das Dictionary hingegen "frißt alles", und anhand der maximalen Anzahl von Controls (aMax) läßt sich ein Array problemlos *nach dem Einlesen* auf die benötigten Grenzen dimensionieren.
Ich habe zusätzlich zur Master- oder Makrodatei ein paar Kopien ohne Makro (.xlsx) angelegt, die Controls enthalten. Diese werden eingelesen.
Falls auch die Makros enthalten können, müßte man in der Schleife abfragen, ob der Name der aufrufendenen Datei bei Dir erreicht wird: die MakroDatei soll ja *nicht* importiert werden. Da wäre eine If-Verzweigung einzusetzen á la
Do While dirDatei > ""
If dirDatei  ThisDocument.Name Then
With Documents.Open(wPfad & dirDatei, ReadOnly:=True)
Ok, das neue Makro befindet sich im Modul "Michael".
Anbei alle 4 Dateien gezipt (Makro, 2 x Dokument mit Daten, Excel-Datei): https://www.herber.de/bbs/user/111827.zip
Schöne Grüße,
Michael
Anzeige
AW: So geht's jetzt
28.02.2017 15:15:08
Urs
Hallo Michael
Sorry dass ich nicht sofort geantwortet habe, inzwischend habe ich den Code von dir als Grundlage und im Excel unter der Arbeitsmappe den folgenden Code angewandt:
Private Sub Workbook_Open()
Worksheets("Dok").Range("A1:ZZ1").Copy
Worksheets("Final").Cells(Worksheets("Final").Rows.Count, 1).End(xlUp).Offset(1, 0). _
PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Columns("A:ZZ").Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 6)), Cells(Rows.Count, 6) _
.End(xlUp).Row, Rows.Count)                                                          _
'Es wird der letzten Eintrag ermittelt
ActiveSheet.Range("a1:ZZ1000" & lngLetzte).RemoveDuplicates _
Columns:=Array(1, 2, 6, 30, 31), Header:=xlYes
Range("A1").Select
End Sub
Im Word wird die Zeile in Excel in Sheet "Dok" geschrieben, danach in Sheet "Final" hinzugefügt, sortiert und duplikate gelöscht.
Ich weiss das dies vermutlich etwas umständlich ist, aber so würde es funktionieren. Das Problem ist eben, dass die Dokumente nicht aufgerufen werden, sondern vom SharePoint direkt geöffnet werden und via Word-Makro in das Excel, Zeile für Zeile eingefügt werden. Am Schluss stehen dann viele Zeilen drin.
Das Problem ist jetzt nur, dass ich das Word Makro nicht in die Symbolliste für den Schnellzugriff ausführen kann, weil immer eine doofe Meldung "Das Makro wurde nicht gefunden oder Aufgrund Ihrer Makroeinstellungen deaktiviert." erscheint.
Ich weiss schon bald nicht mehr wo mir der Kopf steht und irgendeinemal müsste ich das dem Chef geben.
Zum Glück hast du mir weitergeholfen.
Ich müsste wie schon gesagt, der Teil den ich im Excel-Makro habe, in das Word einbinden können. So hätte ich nur im Word den Code.
Werde gerne noch deine Vorschläge anschauen.
Anzeige
AW: So geht's jetzt
28.02.2017 16:02:55
Urs
Hallo Michael
Genial.......
Habe deine Zip-Datei ausgetestet und bin begeistert. So kann man gerne in Kauf nehmen, dass man zuerst die Dokumente vom SharePoint in den Ordner stellt.
Das ist es! Daher brauchst du nichts mehr zu unternehmen.
Hab tausend Dank.
Gruss
Urs
Dann muß ich mich leider entfernen,
28.02.2017 16:06:08
Michael
Urs,
denn mit SharePoint hab ich nix am Hut.
Gutes Gelingen & Grüße,
Michael
P.S.: ich stelle mal nicht auf "offen", weil Du ja zu einer Lösung zu kommen scheinst.
P.P.S.: sag mal, wer sagt denn, daß das direkt in Excel reinmuß? Vielleicht ist einfacher, die Sachen zeilenweise in ein Textdatei zu schreiben (z.B. csv mit irgendeinem Trennzeichen, das in den Controls nicht vorkommt, und wenn es chr(0) ist oder "|") und DIE dann in Excel zu öffnen.
Also gedanklich eine Trennung von "Datenerfassung" ("Eingabe") und "Verarbeitung: den ersten zwei Komponenten von "EVA", wobei A für Ausgabe steht.
Anzeige
AW: So geht's jetzt
28.02.2017 16:35:29
Urs
Hallo Michael
Genial.......
Habe deine Zip-Datei ausgetestet und bin begeistert. So kann man gerne in Kauf nehmen, dass man zuerst die Dokumente vom SharePoint in den Ordner stellt.
Das ist es! Daher brauchst du nichts mehr zu unternehmen.
Hab tausend Dank.
Gruss
Urs
super, das freut mich,
28.02.2017 17:29:09
Michael
Urs,
a) wenn Dir damit geholfen ist und außerdem auch
b) weil ich von Word VBA keine große Ahnung habe: insofern war ich schon etwas stolz auf die "zip" und vor allem: wieder was gelernt!
Also herzlichen Dank für die Rückmeldung &
happy Exceling,
Michael
AW: verstehe ich jetzt nicht,
24.02.2017 16:44:02
Urs
Hallo Michael
oh backe..... Da habe ich richtig gedacht aber falsch geschrieben. Ich müsste in A1, B1 C1....
Sorry.
AW: verstehe ich jetzt nicht,
24.02.2017 16:45:40
Urs
Hallo Michael
oh backe..... Da habe ich richtig gedacht aber falsch geschrieben. Ich müsste in A1, B1 C1....
Sorry.
AW: nur ein Ansatz
24.02.2017 15:52:09
Urs
Hallo Fennek
Danke für die Hilfe.
Bekomme ein Kompillierfehler bei "transpose" "Methode oder Datenobjekt nicht gefunden".
Zur Erinnerung, der VBA Code ist im Word, nicht im Excel!
AW: nur ein Ansatz
24.02.2017 16:01:40
Fennek
Hallo,
falls nach dem Code von Michael noch Bedarf besteht, nutze seinen Ansatz, Excel zu öffnen.
mfg
AW: nur ein Ansatz
24.02.2017 16:03:49
Fennek
oder, vermutlich besser, setze einen Verweis auf xl oben in der Menüliste des VBA-Editors

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige