Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabelle in textfeld in word nach excel kopieren

Tabelle in textfeld in word nach excel kopieren
18.05.2017 22:24:13
paula
Hallo,
ich habe ein Problem und hoffe mir kann jemand helfen. Ich möchte alle Tabellen aus einem Word Dokument in ein Excel file per VBA kopieren.
Das funktioniert an sich schon. Ich habe nur das Problem das einige der Tabellen in Word innerhalb von Textfeldern stehen.
Diese werden dann nicht kopiert. Wie kann ich nun zu den anderen Tabellen auch noch alle die in Textfelder sind in meine Excelmappe kopieren? Ich hoffe mit kann jemand helfen
Hier habe ich ein kleines Beispiel. Die ersten beiden Tabellen werden kopiert ie letzte nicht.
https://www.herber.de/bbs/user/113683.doc
Den Code habe ich aus einer anderen Fragestellung von jemandem angepasst:
Option Explicit
Dim blnTMP As Boolean
Public Sub Test()
Dim objDocument As Object
Dim strDatei As String
Dim strPfad As String
Dim objApp As Object
Dim tab_anz As Integer
Dim i As Integer
Dim lz As Integer
On Error GoTo Fin
Set objApp = OffApp("Word")
lz = 1
If Not objApp Is Nothing Then
Set objDocument = objApp.Documents.Open _
("C:\Users\paula\Desktop\S2\mini2.doc")
tab_anz = objDocument.tables.Count
MsgBox tab_anz
For i = 1 To tab_anz
objDocument.tables(i).Range.Select
objDocument.tables(i).Range.Copy
Sheets(1).Cells(lz + 2, 1).PasteSpecial Paste:=xlPasteValues
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
MsgBox lz
Next i
objDocument.Close False
Else
MsgBox "Applikation nicht installiert!"
End If
Fin:
If Not objApp Is Nothing Then
If blnTMP = True Then
objApp.Quit
blnTMP = False
End If
End If
Set objApp = Nothing
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String, _
Optional blnVisible As Boolean = True) As Object
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, strApp & ".Application")
Select Case Err.Number
Case 429
Err.Clear
Set objApp = CreateObject(strApp & ".Application")
blnTMP = True
If blnVisible = True Then
On Error Resume Next
objApp.Visible = True
Err.Clear
End If
End Select
On Error GoTo 0
Set OffApp = objApp
Set objApp = Nothing
End Function

Es wäre toll wenn mir jemand helfen kann
Liebe Grüße

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ein Anfang
18.05.2017 22:58:00
Fennek
Hallo,
auf den Inhalt des Shapes kann man zugreifen mit:

Sub test()
Dim Tb As Table
Dim Shp As Shape
For Each Tb In ActiveDocument.Tables
Debug.Print Tb.Range.Text
Next Tb
For Each Shp In ActiveDocument.Shapes
Debug.Print Shp.TextFrame.TextRange.Text
Next Shp
End Sub
und mit
Shp.TextFrame.TextRange.copy
den ganzen Bereich kopieren.
mfg
AW: ein Anfang
19.05.2017 16:17:00
Paula
Vielen Dank aber bei mir steigt das Programm bei "For Each Shp In ActiveDocument.Shapes" aus
Ich habe eine word verweis reingehauen und es so verändert:
Public Sub Test()
Dim Appwd As Word.Application
Set Appwd = CreateObject("Word.Application")
Appwd.Visible = True
Dim wdDoc As Word.Document
Set wdDoc = Appwd.documents.Open("C:\Users\pvarnhorn\Desktop\programm\2016_sfcr_risicom.docx")
Dim Tb As Table
Dim Shp As Shape
Dim tab_anz As Integer 'Tabellen anzahl
Dim lz As Integer 'letzte Zeile
Dim i As Integer
For Each Tb In ActiveDocument.Tables
MsgBox Tb.Range.Text
Next Tb
For Each Shp In ActiveDocument.Shapes
Debug.Print Shp.TextFrame.TextRange.Text
Next Shp
End Sub

geändert. Was mache ich falsch?
Anzeige
AW: wdVBA
19.05.2017 16:44:42
Fennek
Hallo,
da ich nur in Wd den Zugriff auf das Shape-Element testen wollte, ist der Code Word-VBA. Der Transfer nach xl muss noch eingefügt werden.
Sowohl ein wd-Makro, der xl öffnet und dort Daten einfügt, ist möglich, wie ein xl-Makro, der wd öffnet und Daten holt.
mfg

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige