批量添加表注demo开源

紫穆清风

添加表注演示图

1. Sub 本科论文表注设置()
   
2.     Application.StatusBar = "开始添加表注……"
   
3.     Set MyDoc = ActiveDocument
   
4.     Set MyTables = MyDoc.Tables
   
5.     t_sum = MyTables.Count
   
6.     b = False
   
7.     If t_sum > 0 Then
   
8.         For Each MyStyle In MyDoc.Styles
   
9.             If MyStyle.NameLocal = "表注" Then
   
10.                 b = True
    
11.                 Exit For
    
12.             Else
    
13.                 b = False
    
14.             End If
    
15.         Next
    
16.         CaptionLabels.Add Name:="表"
    
17.         For Each MyTable In MyTables
    
18. '           如果表格为无框线表格
    
19.             If MyTable.Borders(wdBorderLeft).LineStyle <> wdLineStyleNone Or MyTable.Borders(wdBorderRight).LineStyle <> wdLineStyleNone Or _
    
20.                     MyTable.Borders(wdBorderTop).LineStyle <> wdLineStyleNone Or MyTable.Borders(wdBorderBottom).LineStyle <> wdLineStyleNone Or _
    
21.                     MyTable.Borders(wdBorderHorizontal).LineStyle <> wdLineStyleNone Or MyTable.Borders(wdBorderVertical).LineStyle <> wdLineStyleNone Or _
    
22.                     MyTable.Borders(wdBorderDiagonalDown).LineStyle <> wdLineStyleNone Or MyTable.Borders(wdBorderDiagonalUp).LineStyle <> wdLineStyleNone Then
    
23. '               检测表格上一段落文字是否包含表注
    
24.                 MyTable.Select
    
25.                 Selection.Move unit:=wdParagraph, Count:=-2
    
26.                 Selection.Expand unit:=wdParagraph
    
27.                 If Selection.Range Like "表*#*" And Len(Trim(Selection.Range)) <= 20 Then
    
28.                     If b = True Then
    
29.                         Selection.Range.Style = "表注"
    
30.                     Else
    
31.                         Selection.Range.Style = "题注"
    
32.                         MyStr = "(表注采用默认样式)"
    
33.                     End If
    
34.                 Else
    
35. '                   检测表格下一段落文字是否包含表注
    
36.                     MyTable.Select
    
37.                     Selection.Move unit:=wdParagraph, Count:=1
    
38.                     Selection.Expand unit:=wdParagraph
    
39.                     If Selection.Range Like "表*#*" And Len(Trim(Selection.Range)) < 20 Then
    
40.                         If b = True Then
    
41.                             Selection.Range.Style = "表注"
    
42.                         Else
    
43.                             Selection.Range.Style = "题注"
    
44.                             MyStr = "(表注采用默认样式)"
    
45.                         End If
    
46.                     Else
    
47.                         MyTable.Select
    
48.                         Selection.Move unit:=wdParagraph, Count:=-2
    
49.                         Selection.InsertCaption Label:="表", TitleAutoText:="", Title:="", Position _
    
50.         :=wdCaptionPositionAbove, ExcludeLabel:=0
    
51.                     End If
    
52.                 End If
    
53.             End If
    
54.         Next
    
55.         Application.StatusBar = "表注添加完毕，请检查！" & MyStr
    
56.     Else
    
57.         Application.StatusBar = "本文没有表格"
    
58.     End If
    
59. End Sub

复制代码

紫穆清风

提前占楼。VBA新人小白一枚，代码可能写的很烂，欢迎大家提出意见。
补充几点声明：

1.代码注释中有一个若为无框线表格，则……
因为我个人非常喜欢用无框线的表格排版固定图片，而这样的表格不应该被添加表注，所以我在代码中把它排除了。
2.我喜欢把表注和图注再分别新建一个样式，再不只是用默认的【题注】样式。如果Word文件中新建了一个表注样式，则会将表注文字设置为【表注】样式，如果没有该样式，则在状态栏会提示使用的是默认的【题注】样式
3.下边这句判断表注文字长度的语句数值，我设置的默认值为20个字符，您可以根据需要修改该数值，或者您也可以修改语句，写成一个通用型的。

1. If Selection.Range Like "表*#*" And Len(Trim(Selection.Range)) <= 20 Then

复制代码

413191246se

楼主厉害！刮目相看！

daibao88

谢谢分享！

wdpfox

学习了，谢谢分享！

                                        莫愁前路无知己，天下谁人不识君！只道是：海内存知己，天涯若比邻！