如何给电脑里的每个word文档的每一页右上角批量添加“重要”字样？

lee2237

求大神支招

zldccmx

1. Dim ArryFile(), nFile
   
2. Function SearchFile(ByVal Fd)
   
3. On Error Resume Next
   
4.     Dim Fl
   
5.     Dim SubFd
   
6.     Dim i As Integer
   
7.     i = Fd.Files.Count
   
8.     If i > 0 Then
   
9.         Set RegX = CreateObject("VBSCRIPT.REGEXP")    'RegEx为建立正则表达式
   
10.         With RegX
    
11.             .Global = True    '设置全局可用
    
12.             .Pattern = "(doc|docx|doxm)$"  '输入后缀名用|隔开"(xls|xlsx|docx|doc)$ ，只返回括号中对应文件类型的文件列表
    
13.         End With
    
14.         ReDim Preserve ArryFile(1 To nFile + i)
    
15.         For Each Fl In Fd.Files
    
16.             If RegX.test(Fl.Name) = True Then
    
17.                 nFile = nFile + 1
    
18.                 ArryFile(nFile) = Fl.Path
    
19.             End If
    
20.         Next
    
21.     End If
    
22.     If Fd.SubFolders.Count = 0 Then Exit Function
    
23.     For Each SubFd In Fd.SubFolders '遍历子目录
    
24.         SearchFile SubFd
    
25.     Next
    
26. End Function
    
27. Sub 给所有的WORD文档的每个页面左上角添加标志()
    
28.     Dim Doc As Document
    
29.     Dim Fso
    
30.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
31.     nFile = 0
    
32.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
33.     '    For i = Asc("A") To Asc("Z") '不建议这样循环，进程时间太长
    
34.     '        If Fso.DriveExists(Chr(i)) Then
    
35.     '           SearchFile fso.GetFolder(chr(i) & ":")
    
36.     '        End If
    
37.     '    Next
    
38.     DoEvents
    
39.     SearchFile Fso.GetFolder("D:")  '以D盘为例,搜索整个盘符下所有文件
    
40.     For Each E In ArryFile
    
41.         Set Doc = Documents.Open(E)
    
42.         With ActiveWindow.Selection
    
43.             .HomeKey Unit:=wdStory
    
44.             For i = 1 To Doc.ComputeStatistics(wdStatisticPages) '获得当前文档的总页数
    
45.                 .GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=i '强行跳转到指定页面
    
46.                 With Doc.Shapes.AddTextbox(1, 10, 10, 40, 24) '在页面距左端、上端各10个点画一个长40点高24点的文本框
    
47.                     .Rotation = -22.5 '逆时针旋转22.5
    
48.                     .Line.Visible = False '需要框线则 True 或者取消这一句
    
49.                     .TextFrame.TextRange.InsertAfter "重要" '文本框中的文字
    
50.                     .TextFrame.TextRange.Font.Size = 12 '字体大小，若需要增大字体，则上面对应的文本框大小也要进行相应调整
    
51.                     .TextFrame.TextRange.Font.Color = wdColorDarkRed '暗红色字体
    
52.                 End With
    
53.             Next
    
54.         End With
    
55.         Doc.Close True
    
56.     Next
    
57. End Sub
    
58. 
    

复制代码

zldccmx

参见附件！