Question

我在将表格从MS Word文档导入Excel时遇到问题。对于背景，单词文档的格式都是相同的，“输入”下的信号表是“输出”标题下的信号表。

我希望能够导入表并根据它们在输入标题或输出标题下是否在表之间拆分。 MSWord文档中的设置就像这样

1.1.1输入

[表]

1.1.2输出

[表]

1.1.3 Blah de Blah

到目前为止，我已经导入了所有使用以下代码引用信号的表格，但这就是我能够接受的。任何人都可以帮助我，甚至可以从选择中导入吗？

编辑2/1/17

在ryguy72的评论之后，我更新了代码，以便在代码在excel中运行时从多个选定的word文档中复制表格。我仍然存在的问题是我不需要文件中的所有表，我只需要能够区分上面提到的word doc中的Inputs和Outputs部分，并复制那些特定的表。理想情况下，输入将被复制到一个工作表中，输出复制到另一个工作表中，而工作表保存在单词docs之间，因此它将成为各种数据库。有没有办法做到这一点？

Sub GetWordDocContentsFromAllWordDocuments()
On Error Resume Next
  Dim oWord As Object
  Dim vFiles
  Dim iFile As Integer
  Dim iTable As Integer
  Dim tableNo As Integer
  Dim R As Range

  vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*",     Title:="Please select the files you want to copy from", MultiSelect:=True)
  If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = False
  Set R = Worksheets.Add.Range("A1")
  For iFile = LBound(vFiles) To UBound(vFiles)
    oWord.Documents.Open vFiles(iFile)
    tableNo = oWord.ActiveDocument.tables.Count
    For iTable = 1 To tableNo
        oWord.ActiveDocument.tables(iTable).Select
        oWord.Selection.Copy
        ActiveSheet.Paste R
        Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
    Next
    oWord.ActiveDocument.Close False
  Next
  oWord.Quit
  Set oWord = Nothing
  ActiveSheet.Columns.AutoFit

End Sub

Answer 1

这会将几个Word文档中的表格导入Excel。顺便说一下，它在Excel中运行......

Sub GetWordDocContentsFromAllWordDocuments()
On Error Resume Next
  Dim oWord As Object
  Dim vFiles
  Dim iFile As Integer
  Dim R As Range
  vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True)
  If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = True
  Set R = Worksheets.Add.Range("A1")
  For iFile = LBound(vFiles) To UBound(vFiles)
    oWord.Documents.Open vFiles(iFile)
    oWord.ActiveDocument.Tables(1).Select
    oWord.Selection.Copy
    ActiveSheet.Paste R
    Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
    oWord.ActiveDocument.Close False
  Next
  oWord.Quit
  Set oWord = Nothing
  ActiveSheet.Columns.AutoFit

End Sub



Sub GetWordDocContents()
  Dim oWord As Object
  Dim vFiles
  Dim iFile As Integer
  Dim R As Range
  vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True)
  If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = True
  Set R = Worksheets.Add.Range("A1")
  For iFile = LBound(vFiles) To UBound(vFiles)
    oWord.Documents.Open vFiles(iFile)
    oWord.ActiveDocument.Tables(1).Select
    oWord.Selection.Copy
    ActiveSheet.Paste R
    Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
    oWord.ActiveDocument.Close False
  Next
  oWord.Quit
  Set oWord = Nothing
  ActiveSheet.Columns.AutoFit

End Sub

VBA excel：在特定选择中从MS Word导入表

1 个答案: