0

我的问题是在我通过创建 OLEObject 将 Microsoft Word 中的表格导入 Excel 之后，它不允许我将表格复制并粘贴到 Excel 中。它不断地将我剪贴板上最后复制的任何内容粘贴到第一个单元格中。目前，我的代码向用户询问文件名，在活动的 Excel 工作表中将该文件作为 OLEObject 打开，然后将不正确的信息粘贴到单元格 A1 中。它不是复制和粘贴 Word OLEObject 中的内容。

 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

谢谢！

4

2 回答 2

0

From Word to Excel, should be something like this.

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

Or this.

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
于 2016-06-08T21:56:11.163 回答
0

使用链接中的代码如何在使用 VB 宏将数据从 word 表复制到 excel 表时保留源格式？，我只有在宏将我的 Word 表粘贴到一个全新的单独工作簿中时才能使代码正常工作。当单击我想将 Word 表导入到的 Excel 工作簿中的命令按钮时，该表永远不会粘贴到名为“Scraping Sheets”的工作表中，我已经弄乱了代码，但我能得到的最接近的东西是放置整个表格到一个单元格中，所有格式都丢失了。

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
于 2016-06-13T19:15:45.670 回答