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