把word中的以分页符隔开的一样的表格转成excel横表

xel7000

  excel到word有邮件合并，那
有谁能帮忙“把word中的以分页符隔开的一样的表格转成excel横表” 把word中的以分页符隔开的一样的表格转成excel横表.zip (20.04 KB, 下载次数: 5)

2021-9-8 19:19 上传

点击文件名下载附件
转表

。在此先谢谢！
只是3张表的例子，实际有400多张表。要留置vba代码好应用,急着要。

zldccmx

1. Sub zldccmx()
   
2.     Dim T As Table
   
3.     Dim Arr(1 To 1000, 1 To 12)
   
4.     brr = Array("姓名", "性别", "学籍号",  “出生日期", "身份证号", "家庭地址", "关系", "姓名", "联系电话", "关系", "姓名", "联系电话")
   
5.     For i = 0 To UBound(brr)
   
6.         Arr(1, i+1) = brr(i)
   
7.     Next
   
8.     i = 1
   
9.     For Each T In ThisDocument.Tables
   
10.         T.Select
    
11.         v = Split(Selection.Text, Chr(13) & Chr(7))
    
12.         i = i + 1
    
13.         Arr(i, 1) = v(3)
    
14.         Arr(i, 2) = v(5)
    
15.         Arr(i, 3) = v(11)
    
16.         Arr(i, 4) = v(15)
    
17.         Arr(i, 5) = "'" & v(21)
    
18.         Arr(i, 6) = v(45)
    
19.         Arr(i, 7) = v(52)
    
20.         Arr(i, 8) = v(53)
    
21.         Arr(i, 9) = "'" & v(54)
    
22.         Arr(i, 10) = v(56)
    
23.         Arr(i, 11) = v(57)
    
24.         Arr(i, 12) = "'" & v(58)
    
25.     Next
    
26.   '  Set v = Selection 这一句不需要，调试时留下的垃圾
    
27.     Set xls = CreateObject("excel.Application")
    
28.     With xls.workbooks.Add.activesheet
    
29.         .[a1].Resize(i + 1, 12) = Arr
    
30.         .Name = "学生信息"
    
31.     End With
    
32.     xls.activeworkbook.SaveAs ThisDocument.Path & "\学生信息表.xls", 56
    
33.     xls.Quit
    
34. End Sub
    
35. 
    

复制代码

zldccmx

zldccmx

试试吧  。

jiangxiaoyun

1. Sub fgfgf()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim wdapp As Object, mydoc As Object   '申明wdapp和wdoc变量为对象类型
   
5.     Set wdapp = CreateObject("Word.Application")  '将新建word程序对象赋给变量wdapp
   
6.     Dim mypath$
   
7.     mypath = ThisWorkbook.Path & "\400多页例子学籍基本信息.docx"
   
8.     Set mydoc = wdapp.Documents.Open(mypath)
   
9.     r = mydoc.tables.Count
   
10.     For i = 1 To r
    
11.         With mydoc.tables(i)
    
12.             Cells(i + 1, 1) = Application.Clean(.cell(2, 2).Range) '姓名
    
13.             Cells(i + 1, 2) = Application.Clean(.cell(2, 4).Range) '性别
    
14.             '剩下的自己数word的单元格照着写就是了
    
15.         End With
    
16.     Next
    
17.     mydoc.Close  '最后关闭word不影响
    
18.     wdapp.Quit
    
19. End Sub
    

复制代码

cunfu2010

jiangxiaoyun 发表于 2021-9-8 20:51

学习了，谢谢！

xel7000

zldccmx 发表于 2021-9-8 20:12
试试吧  。

[求助] vba 提取word表格照片
这个怎么弄。

xel7000

zldccmx 发表于 2021-9-8 20:12
试试吧  。

https://club.excelhome.net/thread-1657678-1-1.html
请大神vba帮忙完成下列要求：
根据“400多张表格 学生学籍卡六年级 - 例子”word文档
提照片命名.zip (292.39 KB, 下载次数: 11)
1.  提取每个表格照片到“六年级以身份证命名照片”文件夹。
2.  以表格中对应“身份证号”命名照片。