核心代码:
- Path = GetFileName("WORD文件,*.DOC;*.DOCX")
- Set SHX = Worksheets("DATA")
- SHX.Range("A2:Z1048576").ClearContents
-
- Dim WordApp, Worddoc, MyTable
- Set WordApp = CreateObject("word.application")
- WordApp.Visible = False '关闭word文档的显示
- Set Worddoc = WordApp.Documents.Open(Path)
-
- ROWARR = Split("2,2,3,4,5,6,7,7,8,9,10,11", ",")
- COLARR = Split("2,4,2,2,2,2,2,4,2,2,2,2", ",")
-
- ICOUNT = Worddoc.Tables.Count
- For I = 1 To ICOUNT
-
- Rem 提示信息,在状态栏显示
- Application.StatusBar = "表格总数:" & ICOUNT & " 当前是第:" & I & " 个"
- DoEvents
-
- Set MyTable = Worddoc.Tables(I) '指向第一张WORD表格
- For X = 0 To UBound(ROWARR)
- Set Cell = MyTable.Cell(ROWARR(X), COLARR(X))
- If Not Cell Is Nothing Then '如果单元格存在
- SHX.Cells(I + 1, X + 1).Value = "'" & Replace(Replace(Replace(Replace(Cell.Range.Text, Chr(7), ""), Chr(10), ""), Chr(13), ""), vbCrLf, "")
- End If
- Next
-
- Next
-
- WordApp.Visible = True '关闭word文档的显示
- Worddoc.Close False
- WordApp.Quit
- Set Worddoc = Nothing
复制代码 |