批量提取word指定内容到Excel

duquancai

体力活。。。。。还有就是：Word中某些单元格 有“打勾”的选择项，怎么判断是“打勾的”还是没有打勾的？是整个单元格复制到Excel吗？？？

fxl447098457

Sub my()
Dim fn As String, myapp As Object, Wdoc As Object,i%, j%, TotalPages%, Arr(), k&
Application.ScreenUpdating = False
Set myapp = CreateObject("word.application")
fn = ThisWorkbook.Path & "\模板1.doc"
With myapp
Set Wdoc = .documents.Open(Filename:=fn)
Wdoc.ActiveWindow.View.Type = 3
TotalPages = Wdoc.ActiveWindow.Panes(1).Pages.Count * 2
For i = 1 To TotalPages
If i Mod 2 = 0 Then
  k = k + 1
  ReDim Preserve Arr(1 To 10, 1 To k)
  With Wdoc.tables(i)
  Arr(1, k) = Split(.Cell(1, 2).Range.Text, vbCr)(0)
  Arr(2, k) = Split(.Cell(1, 6).Range.Text, vbCr)(0)
  Arr(3, k) = "'"
  For j = 2 To 19
  Arr(3, k) = Arr(3, k) & Split(.Cell(2, j).Range.Text, vbCr)(0)
  Next j
  Arr(4, k) = Split(.Cell(2, 21).Range.Text, vbCr)(0)
  Arr(5, k) = Split(.Cell(3, 2).Range.Text, "□")(1)
  If Len(Arr(5, k)) >= 5 Then Arr(5, k) = "农村" Else Arr(5, k) = "城镇"
  Arr(6, k) = Split(.Cell(3, 4).Range.Text, vbCr)(0)
  Arr(7, k) = Split(.Cell(5, 2).Range.Text, vbCr)(0)
  Arr(8, k) = Split(.Cell(5, 4).Range.Text, vbCr)(0)
  Arr(9, k) = Split(.Cell(6, 2).Range.Text, vbCr)(0)
  Arr(10, k) = Split(.Cell(8, 4).Range.Text, vbCr)(0)
End With
End If
Next i
Wdoc.Close 0
.Quit
End With
[A1].CurrentRegion.Offset(1).ClearContents
[A2].Resize(UBound(Arr, 2), 10) = Application.Transpose(Arr)
Set myapp = Nothing
Application.ScreenUpdating = True
End Sub

qiucan1012

fxl447098457 发表于 2017-11-23 13:09
Sub my()
Dim fn As String, myapp As Object, Wdoc As Object,i%, j%, TotalPages%, Arr(), k&
Applicat ...

非常好用 谢谢 非常感谢。 感恩

genitous

fxl447098457 发表于 2017-11-23 13:09
Sub my()
Dim fn As String, myapp As Object, Wdoc As Object,i%, j%, TotalPages%, Arr(), k&
Applicat ...

大神，如果是每一个单独的word文档呢，是不是只需要调整一下fn = ThisWorkbook.Path & "\模板1.doc"，其他地方不用动呢

zhangcheng6688

fxl447098457 发表于 2017-11-23 13:09
Sub my()
Dim fn As String, myapp As Object, Wdoc As Object,i%, j%, TotalPages%, Arr(), k&
Applicat ...

你好，谢谢分享这么有用的代码，我比较认真看了一下代码准备修改一下然后应用到我工作需要的地方，现在有几个地方不是很理解，1Wdoc.ActiveWindow.Panes(1).Pages.Count * 2页面为什么要乘以2
2Split(.Cell(1, 2).Range.Text, vbCr)(0)参数（0）是什么意思？3Arr(5, k) = Split(.Cell(3, 2).Range.Text, "□")(1)
  If Len(Arr(5, k)) >= 5 Then Arr(5, k) = "农村" Else Arr(5, k) = "城镇" 这个我也不是很理解。麻烦大神空的时候能不能帮我解答一下，先谢谢了。

fxl447098457

zhangcheng6688 发表于 2017-11-26 08:52
你好，谢谢分享这么有用的代码，我比较认真看了一下代码准备修改一下然后应用到我工作需要的地方，现在有 ...

1------乘以2，是因为一个页面有2个表格，总页数乘以2就是文档总共有的表格数。
2-----因为split拆分出来的是数组，0是取得拆分后的数组的第一个元素内容。
3.利用的是单元格内符号拆分的字长数来确定勾选的是城镇还是农村。因为勾选和没勾选的都是文字符号，一般方法是无法确定是否被勾选，通过拆分后的元素比较下长度来得到结果。

fxl447098457

genitous 发表于 2017-11-24 13:08
大神，如果是每一个单独的word文档呢，是不是只需要调整一下fn = ThisWorkbook.Path & "\模板1.doc"，其 ...

如果是单个文档来用，就如你所说。
如果批量使用。你要遍历文件打开文件，然后才能到我这个后面的过程。

zhangcheng6688

fxl447098457 发表于 2017-11-23 13:09
Sub my()
Dim fn As String, myapp As Object, Wdoc As Object,i%, j%, TotalPages%, Arr(), k&
Applicat ...

大神，还有一个疑问，总页数*2是表格数这个理解，那总的循环数应该也是总页数*2，但是现在“If i Mod 2 = 0 Then”循环数不是少了一半嘛？

fxl447098457

zhangcheng6688 发表于 2017-11-29 13:11
大神，还有一个疑问，总页数*2是表格数这个理解，那总的循环数应该也是总页数*2，但是现在“If i Mod 2 = ...

有一个表格是不需要的，我才排除掉啊。。

zhangcheng6688

fxl447098457 发表于 2017-11-29 13:13
有一个表格是不需要的，我才排除掉啊。。

偶，那个附件数据不是很齐全，打扰了