Word操作辅助类，VB
Word操作辅助类,直接贴代码:
主要包含以下操作 :
文档操作,书签操作 ,文档属性,自定义属性,文字域 等。
代码如下:
'//打开Word文档函数
'//参数sFilePath:文档全路径+文件名
Sub OpenDoc(ByVal sFilePath As String)
If (AppName <> "Microsoft Word") Then
Set owd = CreateObject("Word.Application")
owd.Visible = True
End If
Documents.Open FileName:=sFilePath, _
ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, _
Revert:=False, Format:=wdOpenFormatAuto
End Sub
'//新建Word文档函数
'//参数sFilePath:文档全路径+文件名
Sub DocAdd(ByVal sFilePath As String)
Documents.Add (sFilePath)
End Sub
'//文档保存(临时保存位置)
Sub DocSaveTmp(ByVal sname As String)
Word.ActiveDocument.SaveAs FileName:=sname, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
End Sub
'将文档导出为PDF格式的文档
'参数sFilePath:文档全路径+文件名["C:\test.pdf"]
' bOAE:是否在导出后打开PDF文档
Sub ExportAsPDF(ByVal sFilePath As String, ByVal bOAE As Boolean)
Word.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
sFilePath, ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=bOAE, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub
'激活某个文档
'参数:sDocName:文档名称(全路径)
Function ActivateDocument(ByVal sDocFullName As String) As Boolean
Dim doc As Document
ActivateDocument = False
For Each doc In Word.Documents
If InStr(1, doc.FullName, sDocFullName, 1) Then
doc.Activate
'Windows(doc.Name).Activate
ActivateDocument = True
Exit Function
End If
Next doc
End Function
'取word中书签的内容
'书签名称
Function getValueinBookMark(ByVal sBMName As String) As String
If ActiveDocument.Bookmarks.Exists(sBMName) = True Then
Word.Application.ActiveDocument.Bookmarks(sBMName).Select
getValueinBookMark = CutvbCrLf(Word.Application.Selection.Range.Text)
Else
getValueinBookMark = ""
End If
End Function
'在书签位置填写内容
'参数: sBMName: 书签名称
' sContext:需要更新的内容
Function InitContentofBookMark(ByVal sBMName As String, ByVal sContext As String) As Boolean
If Word.Application.ActiveDocument.Bookmarks.Exists(sBMName) = True Then
'Word.Application.ActiveDocument.Bookmarks(sBMName).Select
'判断内容是否一样
If (Word.Application.ActiveDocument.Bookmarks(sBMName).Range.Text <> sContext) Then
Word.Application.Selection.Goto What:=wdGoToBookmark, Name:=sBMName
Word.Application.Selection.Find.ClearFormatting
Word.Application.Selection.TypeText Text:=sContext + " "
End If
InitContentofBookMark = True
Else
InitContentofBookMark = False
End If
End Function
'更新书签内容
'参数: sBMName: 书签名称
' sContext:需要更新的内容
Function UpdateContentofBookMark(ByVal sBMName As String, ByVal sContext As String) As Boolean
If Word.Application.ActiveDocument.Bookmarks.Exists(sBMName) = True Then
'判断内容是否一样
Dim wdRng As Word.Range
Set wdRng = Word.Application.ActiveDocument.Bookmarks(sBMName).Range
If (wdRng.Text <> sContext) Then
wdRng.Cut
wdRng.insertBefore (sContext + " ")
End If
UpdateContentofBookMark = True
Set wdRng = Nothing
Else
UpdateContentofBookMark = False
End If
End Function
'取word表格的内容,去除特殊字符
'参数:t table索引;r 行数;c 列数
'返回值: 表格的值,特殊情况:'-':不存在或者合并单元的内容
Function getTableCellsValue(ByVal t As Integer, ByVal r As Integer, ByVal c As Integer) As String
On Error GoTo g1:
getTableCellsValue = Word.Application.ActiveDocument.Tables(t).Cell(r, c).Range.Text
Exit Function
g1:
getTableCellsValue = "-"
End Function
'将当前文档的属性全部打印出来
Sub PrintDocumentProperties()
Dim rngDoc As Word.Range
Dim proDoc As DocumentProperty
Set rngDoc = Word.ActiveDocument.Content
rngDoc.Collapse Direction:=wdCollapseEnd
For Each proDoc In Word.ActiveDocument.BuiltinDocumentProperties
With rngDoc
.InsertParagraphAfter
.InsertAfter proDoc.Name & "= "
On Error Resume Next
.InsertAfter proDoc.value
End With
Next
'MsgBox Word.ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle).Value
End Sub
'取文档类型属性值
Function getValueOfPropertyCategory() As String
getValueOfPropertyCategory = getValueOfProperty(wdPropertyCategory)
End Function
'设置文档类型值
'参数:文档类型的值
Sub setValueOfPropertyCategory(ByVal sValue As String)
Call setValueOfProperty(wdPropertyCategory, sValue)
End Sub
'取文档属性值
'参数:属性
'返回值:属性的值
Function getValueOfProperty(ByRef PropertyName As WdBuiltInProperty) As String
getValueOfProperty = Word.ActiveDocument.BuiltinDocumentProperties(PropertyName).value
End Function
'设置文档属性值
'参数:属性,值
Sub setValueOfProperty(ByRef PropertyName As WdBuiltInProperty, ByVal sValue As String)
Word.ActiveDocument.BuiltinDocumentProperties(PropertyName) = sValue
'SendKeys '接受更改值
End Sub
'取文档自定义属性值
'参数:属性名称
'返回值:属性的值
Function getValueOfCustomProperty(ByVal sname As String) As String
If existCustomProperty(sname) Then
getValueOfCustomProperty = Word.ActiveDocument.CustomDocumentProperties(sname).value
Else
getValueOfCustomProperty = ""
End If
End Function
'新增文档自定义属性及值
'参数:属性名称,值,类型(4:文本,3:日期,2:是否,1:数字),链接
'like :addCustomProperty "url", "wwwl.80.hk", 4, False
Sub addCustomProperty(ByVal sname As String, ByVal sValue As Variant, ByVal iType As Integer, ByVal bLink As Boolean)
Word.ActiveDocument.CustomDocumentProperties.Add sname, bLink, iType, sValue
End Sub
'修改自定义属性的值
'参数:属性名称,属性值(类型一定要匹配)
Sub updateValueofCustomProperty(ByVal sname As String, ByVal vValue As Variant)
If existCustomProperty(sname) Then
Word.ActiveDocument.CustomDocumentProperties(sname).value = vValue
End If
End Sub
'删除文档自定义属性
'参数:自定义属性的名称
Sub deleteCustomProperty(ByVal sname As String)
If existCustomProperty(sname) Then
Word.ActiveDocument.CustomDocumentProperties(sname).Delete
End If
End Sub
'是否存在自定义属性
'参数:sCustomPropertyName:自定义属性名称
'返回值:True:存在,False:不存
Function existCustomProperty(ByVal sCustomPropertyName As String) As Boolean
Dim myCustomProperty As Variant
existCustomProperty = False
For Each myCustomProperty In Word.ActiveDocument.CustomDocumentProperties
If myCustomProperty.Name = sCustomPropertyName Then
existCustomProperty = True
Exit For
End If
Next
End Function
'设置文字域的内容
'参数:sTextFieldName:文字域名称,sResult:文字域内容
Sub setResultOfTextField(ByVal sTextFieldName As String, ByVal sResult As String)
If existTextField(sTextFieldName) Then
Word.ActiveDocument.FormFields(sTextFieldName).result = sResult
End If
End Sub
'获取文字域的内容
'参数:sTextFieldName:文字域名称
Function getResultOfTextField(ByVal sTextFieldName As String) As Variant
If existTextField(sTextFieldName) Then
getResultOfTextField = Word.ActiveDocument.FormFields(sTextFieldName).result
Else
getResultOfTextField = ""
End If
End Function
'是否存在该文字域
'参数:sTextFieldName:文字域名称
'返回值:True:存在该文字域,Else:不存在该文字域
Function existTextField(ByVal sTextFieldName As String) As Boolean
Dim myTextField As FormField
existTextField = False
For Each myTextField In Word.ActiveDocument.FormFields
If myTextField.Name = sTextFieldName Then
existTextField = True
Exit For
End If
Next
End Function
'文档最后
Function DocEnd() As Range
Set DocEnd = Word.ActiveDocument.Range(Word.ActiveDocument.Range.End - 1, Word.ActiveDocument.Range.End - 1)
'DocEnd.InsertAfter ("last paragrap")
End Function