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