月度归档： 2024 年 7 月

Public Sub ReplaceWord(ByVal vWord As Variant, ByVal sOld As String, ByVal sNew As String)
Const wdReplaceAll = 2
Const wdFindStop = 0
Dim oRange As Object
Set oRange = vWord.Selection.Range
‘先判断是否有选中区域，没有选中则表示整个文档
If oRange.Start = oRange.End Then
Set oRange = vWord.ActiveDocument.Content
End If
With oRange.Find
‘批量查找替换 sOld 为 sNew
bRet = .Execute(FindText:=sOld, replacewith:=sNew, Replace:=wdReplaceAll)
‘Debug.Print bRet
‘Debug.Print oRange.Words.Count
End With
End Sub

Public Sub InsPageNumber(ByVal vWord As Variant) ‘其实是 vDocument
On Error GoTo ERR_PAGENUMBER
‘设置Word文档第一页页码
Dim oRange As Object
Set oRange = vWord.ActiveDocument.Sections(1).Footers(1).Range ‘wdHeaderFooterPrimary = 1
With oRange
.InsertAfter “第”
‘.Font.Size = 14
.Collapse Direction:=0 ‘wdCollapseEnd = 0
‘插入页码域
.Fields.Add Range:=oRange, Type:=-1, Text:=”PAGE * Arabic “, PreserveFormatting:=True ‘wdFieldEmpty = -1
.Expand Unit:=2 ‘wdWord = 2
.InsertAfter “页”
.InsertAfter “共”
.Collapse Direction:=0 ‘wdCollapseEnd = 0
‘插入页数域
.Fields.Add Range:=oRange, Type:=-1, Text:=”NUMPAGES * Arabic “, PreserveFormatting:=True ‘wdFieldEmpty = -1
.Expand Unit:=2 ‘wdWord = 2
.InsertAfter “页”
‘.InsertAfter “YagerSoft”
.ParagraphFormat.Alignment = 2 ‘wdAlignParagraphRight = 2 ‘右对齐
End With
‘隐藏页眉的横线
vWord.ActiveDocument.Sections(1).Headers(1).Range.Borders(-3).Visible = False ‘wdBorderBottom = -3
‘取得页眉的内容
‘Debug.Print vWord.ActiveDocument.Sections(1).Headers(2).Range.Text ‘wdHeaderFooterFirstPage = 2
Set oRange = Nothing
On Error GoTo 0
Exit Sub
ERR_PAGENUMBER:
On Error GoTo 0
End Sub

Public Sub InsPageBreak(ByVal vWord As Variant)
On Error GoTo ERR_BREAK
‘wdPropertyTitle = 1标题
‘wdPropertySubject = 2主题
‘wdPropertyAuthor = 3作者
‘wdPropertyKeywords = 4关键词
‘wdPropertyComments = 5批注
‘wdPropertyTemplate = 6模板
‘wdPropertyLastAuthor = 7上一个作者
‘wdPropertyRevision = 8修订次数
‘wdPropertyAppName = 9应用程序名
‘wdPropertyTimeLastPrinted = 10上次打印时间
‘wdPropertyTimeCreated = 11创建时间
‘wdPropertyTimeLastSaved = 12上次保存时间
‘wdPropertyVBATotalEdit = 13编辑时间总计
‘wdPropertyPages = 14页数
‘wdPropertyWords = 15字数
‘wdPropertyCharacters = 16字符数
‘wdPropertySecurity = 17安全性
‘wdPropertyCategory = 18类别
‘wdPropertyFormat = 19
‘wdPropertyManager = 20经理
‘wdPropertyCompany = 21公司
‘wdPropertyBytes = 22字节数
‘wdPropertyLines = 23行数
‘wdPropertyParas = 24段数(空白文档 BuiltInDocumentProperties(wdPropertyParas) = 0，而 vWord.ActiveDocument.Paragraphs.Count = 1)
‘wdPropertySlides = 25
‘wdPropertyNotes = 26注释
‘wdPropertyHiddenSlides = 27
‘wdPropertyMMClips = 28
‘wdPropertyHyperlinkBase = 29
‘wdPropertyCharsWSpaces = 30字符数（计空格）
If vWord.ActiveDocument.BuiltInDocumentProperties(15) = 0 Then Exit Sub ‘wdPropertyWords = 15
vWord.Selection.EndKey Unit:=6 ‘wdStory = 6 ‘将光标移到最后
vWord.Selection.InsertBreak Type:=7 ‘wdPageBreak = 7 ‘插入分页符
On Error GoTo 0
Exit Sub
ERR_BREAK:
On Error GoTo 0
End Sub

Public Function FindWord(ByVal vWord As Variant, ByVal sData As String) As Boolean
Dim oSelection As Object
Set oSelection = vWord.ActiveDocument.Content
‘利用FIND查找 sData ，从光标之处开始查找，查找到后选中。
With oSelection.Find
‘查找的方向向下
.Forward = True
‘取消在查找或替换操作中所指定文本的文本格式和段落格式
.ClearFormatting
‘查找操作查找仅完整单词，而不是较长单词的一部分的文本
.MatchWholeWord = True
‘查找时不区分大小写
.MatchCase = False
‘到达文档末尾时，继续从文档开头进行搜索
.Wrap = 1 ‘wdFindContinue
‘运行指定的查找操作。如果查找成功，则返回 True
.Execute FindText:=sData
End With
FindWord = oSelection.Find.Execute
End Function

Public Function GetTextSite(ByVal vWord As Variant, ByVal sText As String) As Integer ‘返回 sText 在 vWord 中首次出现的段号
‘耗时过长不宜用
Dim I As Integer, J As Integer
GetTextSite = 0
If vWord Is Nothing Then Exit Function
If vWord.Documents.Count = 0 Then Exit Function
If sText = “” Then Exit Function
For I = 1 To vWord.ActiveDocument.Paragraphs.Count
DoEvents
‘If vWord.ActiveDocument.Paragraphs(I).Range.Text = sText Then
If InStr(1, vWord.ActiveDocument.Paragraphs(I).Range.Text, sText, vbTextCompare) > 0 Then
GetTextSite = I
Exit For
End If
Next I
End Function