Kopieren und Einfügen von Informationen aus Microsoft Word OLEObject in Excel-Datei über VBA

Question

Mein Problem ist, nachdem ich eine Tabelle aus Microsoft Word in Excel importiert, indem Sie ein OLEObject erstellen, wird es nicht kopieren und fügen Sie die Tabelle in Excel. Es fügt fortlaufend das, was zuletzt in meiner Zwischenablage kopiert wurde, in die erste Zelle ein. Derzeit fragt mein Code den Benutzer nach dem Dateinamen, öffnet diese Datei als OLEObject in der aktiven Excel-Tabelle und fügt dann die falsche Information in Zelle A1 ein. Es wird nicht kopiert und eingefügt, was sich in dem Word OLEObject befindet.

Sub Macro1() 
    Dim FName As String, FD As FileDialog 
    Dim ExR As Range 
    Set FD = Application.FileDialog(msoFileDialogOpen) 
    FD.Show 
    If FD.SelectedItems.Count <> 0 Then 
     FName = FD.SelectedItems(1) 
    Else 
     Exit Sub 
    End If 

    ActiveSheet.OLEObjects.Add(fileName:=FName, Link:=False, DisplayAsIcon:=False).Select 
    Selection.Verb Verb:=xlPrimary 
    Range("A1").Select 
    ActiveSheet.Paste 

End Sub 

Vielen Dank!

Answer 1

Von Word zu Excel, sollte so etwas sein.

Sub ImportFromWord() 

'Activate Word Object Library 

'Dim WordApp As Word.Application  
Dim WordDoc As Word.Document 

Set WordApp = CreateObject("word.application") ' Open Word session 

WordApp.Visible = False 'keep word invisible 
Set WordDoc = WordApp.Documents.Open("C:\Users\your_path_here_\WordFile.docx") ' open Word file 

'copy third row of first Word table 
WordDoc.Tables(1).Rows(3).Range.Copy 

'paste in Excel 
Range("A1").PasteSpecial xlPasteValues 

WordDoc.Close 'close Word doc 
WordApp.Quit ' close Word 

End Sub 

Oder dies.

Sub GetTables() 

FName = Application _ 
.GetOpenFilename("Word Files (*.doc), *.doc") 

Set WordObject = GetObject(FName) 

First = True 
RowCount = 2 
For Each Tble In WordObject.tables 
For i = 1 To 22 
If First = True Then 
Data = Tble.Rows(i).Cells(1).Range 
'Remove cell markers 
Cells(1, i) = Left(Data, Len(Data) - 2) 
End If 
Data = Tble.Rows(i).Cells(2).Range.Text 
'Remove cell markers 
Cells(RowCount, i) = Left(Data, Len(Data) - 2) 
Next i 
RowCount = RowCount + 1 
First = False 
Next Tble 
WordObject.Close savechanges = False 
End Sub 

Answer 2

Verwenden Sie den Code aus dem Link How to preserve source formatting while copying data from word table to excel sheet using VB macro? habe ich nur in der Lage gewesen, den Code zu arbeiten, wenn die Makro-Pasten meiner Word-Tabelle in einer ganz neuen separaten Arbeitsmappe. Wenn Sie auf eine Befehlsschaltfläche innerhalb der Excel-Arbeitsmappe klicken, in die ich die Word-Tabelle importieren möchte, wird die Tabelle nicht in das Blatt "Scraping Sheets" eingefügt, das ich mit dem Code durcheinander gebracht habe, aber das nächste, was ich bekommen konnte, war Platzierung Die gesamte Tabelle in eine Zelle mit allen Formatierungen verloren.

Private Sub CommandButton22_Click() 
Dim oWordApp As Object, oWordDoc As Object 
Dim FlName As String 
Dim tbl As Object 

FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _ 

On Error Resume Next 
Set oWordApp = GetObject(, "Word.Applicaton") 

If Err.Number <> 0 Then 
    Set oWordApp = CreateObject("Word.Application") 
End If 
Err.Clear 
On Error GoTo 0 

oWordApp.Visible = True 


Set oWordDoc = oWordApp.Documents.Open(FlName) 

Set tbl = oWordDoc.Tables(1) 

Dim wb As Workbook, ws As Worksheet 

Set wb = Workbooks.Open(""C:\Users\xxxx\Desktop\292 Int'l_Weekly_Win_Loss_YYYY MM DD TEMPLATE.xlsm"") 

Set ws = wb.Sheets("Scraping Sheet") 

tbl.Range.Copy 

ws.Range("A1").Activate 

ws.Paste 

MsgBox "Successfully Added File!" 
End Sub