WORD模块

WORD模块

'表格的宽度的首选度量单位
Private Const wdPreferredWidthPoints = 3 '磅
Private Const wdPreferredWidthPercent = 2 '百分比

'度量单位
Private Const wdCharacter = 1 '字符
Private Const wdParagraph = 4 '段落
Private Const wdLine = 5 '行
Private Const wdStory = 6 '文档正文
Private Const wdColumn = 9
Private Const wdRow = 10
Private Const wdCell = 12
Private Const wdScreen = 7

'对齐方式
Private Const wdAlignRowCenter = 1 '居中

Private Const wdMove = 0 '移动
Private Const wdExtend = 1 '移动且选择
Private Const wdActiveEndPageNumber = 3
Private Const wdNumberOfPagesInDocument = 4

Private Const wdFindStop = 0 '结束对所选内容或区域的搜索后，Word 会显示一条消息，询问是否搜索文档的其余部分。
Private Const wdFindContinue = 1 '查找结束后是否继续
Private Const wdFindAsk = 2 '到达搜索区域的开头或结尾时，停止执行查找操作。

Private Const wdReplaceAll = 2 '全部替换
'WdGoToItem
'Private Enum WdGoToItemType '指定区域或所选内容要移动到的项的类别
Private Const wdGoToBookmark = -1
Private Const wdGoToComment = 6
Private Const wdGoToEndnote = 5
Private Const wdGoToEquation = 10
Private Const wdGoToField = 7
Private Const wdGoToFootnote = 4
Private Const wdGoToGrammaticalError = 14
Private Const wdGoToGraphic = 8
Private Const wdGoToHeading = 11
Private Const wdGoToLine = 3
Private Const wdGoToObject = 9
Private Const wdGoToPage = 1
Private Const wdGoToPercent = 12
Private Const wdGoToProofreadingError = 15
Private Const wdGoToSection = 0
Private Const wdGoToSpellingError = 13
Private Const wdGoToTable = 2
'End Enum
'Private Enum WdGoToDirection '指定区域或所选内容要移动到的项
Private Const wdGoToAbsolute = 1
Private Const wdGoToFirst = 1
Private Const wdGoToLast = -1
Private Const wdGoToNext = 2
Private Const wdGoToPrevious = 3
Private Const wdGoToRelative = 2
'End Enum
Private Const wdBorderVertical = -6
Private Const wdBorderHorizontal = -5
Private Const wdBorderRight = -4
Private Const wdBorderBottom = -3
Private Const wdBorderTop = -1
Private Const wdBorderLeft = -2


Public Function WordOpen(o_Word As Object, FilePath As String)
Dim o_WordDoc As Object
Set o_WordDoc = o_Word.Documents.Open(FilePath) '打开文件并赋予文件实例
Set WordOpen = o_WordDoc
o_Word.Visible = True
End Function
Public Function WordNew(o_Word As Object)
'新建一个WORD，返回一个文档对象
Dim o_WordDoc As Object
Set o_WordDoc = o_Word.Documents.Add
Set WordNew = o_WordDoc
o_Word.Visible = True
End Function



'########### WORD 文档操作 ##############

Public Sub WordAddText(o_WordDoc As Object, sText As String, Optional mode As Long = 1)
'在文档中插入文字
Dim strLen As Long
Dim SelLen As Long
Di

m SelStr As String
Dim i As Long
If mode = 0 Then '前面
o_WordDoc.Content.InsertBefore Text:=sText
End If
If mode = 1 Then '光标插入点
o_WordDoc.ActiveWindow.Selection.TypeText Text:=sText
End If
If mode = 2 Then '后面
o_WordDoc.Content.InsertAfter Text:=sText
End If


End Sub


'################## 表格操作 ###################

Public Function WordGetTableObj(o_WordDoc As Object, Optional TableID As Long = 1)
'获得文档中的表对象
If TableID > 0 And TableID <= o_WordDoc.Tables.Count Then
Set WordGetTableObj = o_WordDoc.Tables(TableID)
End If
End Function
Public Function WordGetTableCount(o_WordDoc As Object)
'获得文档中表的数量
WordGetTableCount = o_WordDoc.Tables.Count
'Debug.Print o_WordDoc.Tables(TabID).Rows.Count '所选表格的总行数
'Debug.Print o_WordDoc.Tables(TabID).Rows(1).cells.Count '所选表格第一行的单元格数
End Function
Public Function WordAddTable(o_WordDoc As Object, Optional RowNum As Long = 1, Optional ColNum As Long = 1)
Dim TabCount As Long
Dim o_wdTable As Object
'在文档中添加一个表，返回添加的表对象
'Set myRange = o_WordDoc.Range(Start:=0, End:=0)
'o_WordDoc.ActiveWindow.Selection.GoTo What:=wdGoToEndnote, Which:=wdGoToRelative, Count:=1
Set myRange = o_WordDoc.ActiveWindow.Selection.Range
o_WordDoc.Tables.Add Range:=myRange, NumRows:=RowNum, NumColumns:=ColNum

TabCount = o_WordDoc.Tables.Count
Set o_wdTable = o_WordDoc.Tables(TabCount)
o_wdTable.Rows.Alignment = wdAlignRowCenter
Set WordAddTable = o_wdTable
End Function
Public Function WordGetTabRowCount(o_WordObj As Object, Optional TableID As Long = 0)
'获得指定表中行的数量
Dim o_wdTable As Object

WordGetTabRowCount = 0
If TypeName(o_WordObj) = "Table" Then
WordGetTabRowCount = o_WordObj.Rows.Count
End If
If TypeName(o_WordObj) = "Document" Then
Set o_wdTable = WordGetTableObj(o_WordObj, TableID)
WordGetTabRowCount = o_wdTable.Rows.Count
End If

End Function
Public Sub WordDelTable(o_WordObj As Object, Optional TableID As Long = 0)
'删除指定的表
Dim o_wdTable As Object
If TypeName(o_WordObj) = "Table" Then
o_WordObj.Delete
End If
If TypeName(o_WordObj) = "Document" Then
Set o_wdTable = WordGetTableObj(o_WordObj, TableID)
o_wdTable.Delete
End If
End Sub

Public Sub WordDelRow(o_WordObj As Object, Optional StartRow As Long = 1, Optional DelRowCount As Long = 1, Optional TableID As Long = 0)
'删除指定表的行,StartRow为开始行,DelRowCount为需要删除行的总数
Dim o_wdTable As Object
'Dim Rows As Long
Dim Row As Long
If TypeName(o_WordObj) = "Table" Then
For Row = 1 To DelRowCount
o_WordObj.Rows(StartRow).Delete
Next
End If
If TypeName(o_WordObj) = "Document" Then
Set o_wdTable = WordGetTableObj(o_WordObj, TableID)
For Row = 1 To DelRowCount
o_wdTable.Rows(StartRow).Delete
Next
End If

End Sub
Public Sub WordAddRow(o_Wor

dObj As Object, Optional StartRow As Long = 1, Optional AddRowCount As Long = 1, Optional AddMode As Long = 0, Optional TableID As Long)
'增加指定表的行,StartRow为开始行,DelRowCount为需要增加行的总数
Dim o_wdTable As Object
If TypeName(o_WordObj) = "Table" Then
Set o_wdTable = o_WordObj
End If
If TypeName(o_WordObj) = "Document" Then
Set o_wdTable = WordGetTableObj(o_WordObj, TableID)
End If

o_wdTable.Rows(StartRow).Select
If AddMode = 1 Then
'在当前选定内容上方插入行。
o_wdTable.Parent.ActiveWindow.Selection.InsertRowsAbove AddRowCount
Else
'在当前选定内容下方插入行。
o_wdTable.Parent.ActiveWindow.Selection.InsertRowsBelow AddRowCount
End If

End Sub

Public Sub WordCellAddText(o_WordObj As Object, Row As Long, Column As Long, sText As String, Optional TableID As Long = 0)
'在表格中添加文字
Dim o_wdTable As Object
If Len(sText) > 0 Then
If TypeName(o_WordObj) = "Table" Then
o_WordObj.Cell(Row, Column).Range.Text = sText
End If
If TypeName(o_WordObj) = "Document" Then
Set o_wdTable = WordGetTableObj(o_WordObj, TableID)
o_wdTable.Cell(Row, Column).Range.Text = sText
End If
End If
End Sub

'############ 查找、替换文本 #######################
Public Sub WordChangeText(o_WordDoc As Object, FindText As String, ChangeText As String)
'在WORD中替换文本
Dim o_Range As Object
Set o_Range = o_WordDoc.Content
If Len(ChangeText) > 220 Then '如果长度大于220，则使用剪贴板
Clipboard.Clear
Clipboard.SetText ChangeText
o_Range.Find.Execute FindText:=FindText, _
ReplaceWith:="^c"
Else
o_Range.Find.Execute FindText:=FindText, _
ReplaceWith:=ChangeText, Replace:=wdReplaceAll
End If
End Sub

Public Function GetActivePage(o_WordDoc As Object)
'返回当前页码
GetActivePage = o_https://www.wendangku.net/doc/093723532.html,rmation(wdActiveEndPageNumber)
End Function
Public Function GetNumPage(o_WordDoc As Object)
'返回总页码
GetNumPage = o_https://www.wendangku.net/doc/093723532.html,rmation(wdNumberOfPagesInDocument)
End Function
Public Sub PutPage(PageStartingNumber As Long, Format As Long)
'插入页码
'Dim Format As Long
With wordApp.ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers
If PageStartingNumber <= 1 Then .RestartNumberingAtSection = False
.StartingNumber = PageStartingNumber
.Add PageNumberAlignment:=wdAlignPageNumberCenter, _
FirstPage:=True
End With
End Sub


'################## 辅助函数 #####################
Private Function FullFileNameToFileName(FileName As String) '转换文件名
Dim strTemp() As String
'--------将FileName整理成规范格式----------
'book1.xls f:\book1.xls 整理成 boo1.xls
If InStr(1, FileName, "\") Then
strTemp = Split(FileName, "\")
FullFileNameToFileName = strTemp(UBound(strTemp)) '取最后
Else
FullFileNameToFi

leName = FileName
End If
End Function
Private Function mmToPixel(dVal As Double)
'毫米转像素
mmToPixel = dVal / 0.26458333333
End Function
Private Function PixelTomm(dVal As Double)
'像素转毫米
PixelTomm = dVal * 0.26458333333
End Function
Private Function PoundToPixel(dVal As Double)
'磅转像素
PoundToPixel = dVal / 0.75
End Function
Private Function PixelToPound(dVal As Double)
'像素转磅
PixelToPound = dVal * 0.75
End Function
Private Function InchToPixel(dVal As Double)
'英寸转像素
InchToPixel = dVal / 0.010********
End Function
Private Function PixelToInch(dVal As Double)
'像素转英寸
PixelToInch = dVal * 0.010********
End Function
Private Function PixelTohuozi(dVal As Double)
'像素转12点活字
PixelTohuozi = dVal * 0.0625
End Function
Private Function huoziToPixel(dVal As Double)
'12点活字转像素
huoziToPixel = dVal / 0.0625
End Function
Private Function PoundTomm(dVal As Double)
'磅转毫米
PoundTomm = PixelTomm(PoundToPixel(dVal))
End Function
Private Function mmToPound(dVal As Double)
'毫米转磅
mmToPound = PixelToPound(mmToPixel(dVal))
End Function