vb控制word的类模块,查找、替换Word文档内容
来源:互联网 发布:java 断点下载 编辑:程序博客网 时间:2024/05/06 02:06
在vb6.0中,操作Word,使用它强大的查找、替换、删除、复制、翦切功能。还可以把特定字符替换成图片。有了它你就可以使用数据库中的内容或图片文件替换Word文件中的特定字符。
只要把下列内容复制到写字板中,另存为SetWord.cls文件,然后在把它添加到工程中,就可以使用了。
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute vb_Name = "SetWord"
Attribute vb_GlobalNameSpace = False
Attribute vb_Creatable = True
Attribute vb_PredeclaredId = False
Attribute vb_Exposed = False
Private mywdapp As Word.Application
Private mysel As Object
'属性值的模块变量
Private C_TemplateDoc As String
Private C_newDoc As String
Private C_PicFile As String
Private C_ErrMsg As Integer
Public Event HaveError()
Attribute HaveError.vb_Description = "出错时激发此事件.出错代码为ErrMsg属性"
'***************************************************************
'ErrMsg代码:1-Word没有安装 2 - 缺少参数 3 - 没权限写文件
' 4 - 文件不存在
'
'***************************************************************
Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As Integer
Attribute ReplacePic.vb_Description = "查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时,替换所有"
'********************************************************************************
' 从Word.Range对象mysel中查找所有FindStr,并替换为PicFile图像
' 替换次数由time参数确定,为0时,替换所有
'********************************************************************************
If Len(C_PicFile) = 0 Then
C_ErrMsg = 2
Exit Function
End If
Dim i As Integer
Dim findtxt As Boolean
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=True)
If Not findtxt Then
ReplacePic = 0
Exit Function
End If
i = 1
Do While findtxt
mysel.InlineShapes.AddPicture FileName:=C_PicFile
If i = Time Then Exit Do
i = i + 1
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=True)
Loop
ReplacePic = i
End Function
Public Function FindThis(FindStr As String) As Boolean
Attribute FindThis.vb_Description = "查找FindStr,如果模板中有FindStr则返回True"
If Len(FindStr) = 0 Then
C_ErrMsg = 2
Exit Function
End If
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
mysel.HomeKey Unit:=wdStory
FindThis = mysel.Find.Execute
End Function
Public Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0) As Integer
Attribute ReplaceChar.vb_Description = "查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时,替换所有"
'********************************************************************************
' 从Word.Range对象mysel中查找FindStr,并替换为RepStr
' 替换次数由time参数确定,为0时,替换所有
'********************************************************************************
Dim findtxt As Boolean
If Len(FindStr) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Function
End If
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = RepStr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
If Time > 0 Then
For i = 1 To Time
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=wdReplaceOne)
If Not findtxt Then Exit For
Next
If i = 1 And Not findtxt Then
ReplaceChar = 0
Else
ReplaceChar = i
End If
Else
mysel.Find.Execute Replace:=wdReplaceAll
End If
End Function
Public Function GetPic(PicData() As Byte, FileName As String) As Boolean
Attribute GetPic.vb_Description = "把图像数据PicData,存为PicFile指定的文件"
'********************************************************************************
' 把图像数据PicData,存为PicFile指定的文件
'********************************************************************************
On Error Resume Next
If Len(FileName) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Function
End If
Open FileName For Binary As #1
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Function
End If
'二进制文件用Get,Put存放,读取数据
Put #1, , PicData
Close #1
C_PicFile = FileName
GetPic = True
End Function
Public Sub DeleteToEnd()
Attribute DeleteToEnd.vb_Description = "删除从当前位置到结尾的所有内容"
mysel.EndKey Unit:=wdStory, Extend:=wdExtend
mysel.Delete Unit:=wdCharacter, Count:=1
End Sub
Public Sub MoveEnd()
Attribute MoveEnd.vb_Description = "光标移动到文档结尾"
'光标移动到文档结尾
mysel.EndKey Unit:=wdStory
End Sub
Public Sub GotoLine(LineTime As Integer)
mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:=""
End Sub
Public Sub OpenDoc(view As Boolean)
Attribute OpenDoc.vb_Description = "打开Word文件,View确定是否显示Word界面"
On Error Resume Next
'********************************************************************************
' 打开Word文件,并给全局变量mysel赋值
'********************************************************************************
If Len(C_TemplateDoc) = 0 Then
mywdapp.Documents.Add
Else
mywdapp.Documents.Open (C_TemplateDoc)
End If
If Err.Number <> 0 Then
C_ErrMsg = 4
RaiseEvent HaveError
Exit Sub
End If
mywdapp.Visible = view
mywdapp.Activate
Set mysel = mywdapp.Application.Selection
'mysel.Select
End Sub
Public Sub OpenWord()
On Error Resume Next
'********************************************************************************
' 打开Word程序,并给全局变量mywdapp赋值
'********************************************************************************
Set mywdapp = CreateObject("Word.application")
If Err.Number <> 0 Then
C_ErrMsg = 1
RaiseEvent HaveError
Exit Sub
End If
End Sub
Public Sub ViewDoc()
Attribute ViewDoc.vb_Description = "显示Word程序界面"
mywdapp.Visible = True
End Sub
Public Sub AddNewPage()
Attribute AddNewPage.vb_Description = "插入分页符"
mysel.InsertBreak Type:=wdPageBreak
End Sub
Public Sub WordCut()
Attribute WordCut.vb_Description = "剪切模板所有内容到剪切板"
'保存模板页面内容
mysel.WholeStory
mysel.Cut
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordCopy()
Attribute WordCopy.vb_Description = "拷贝模板所有内容到剪切板"
mysel.WholeStory
mysel.Copy
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordDel()
mysel.WholeStory
mysel.Delete
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordPaste()
Attribute WordPaste.vb_Description = "拷贝剪切板内容到当前位置"
'插入模块内容
mysel.Paste
End Sub
Public Sub CloseDoc()
Attribute CloseDoc.vb_Description = "关闭Word文件模板"
'********************************************************************************
' 关闭Word文件模本
'********************************************************************************
On Error Resume Next
mywdapp.ActiveDocument.Close False
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Sub
End If
End Sub
Public Sub QuitWord()
'********************************************************************************
' 关闭Word程序
'********************************************************************************
On Error Resume Next
mywdapp.Quit
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Sub
End If
End Sub
Public Sub SavetoDoc()
Attribute SavetoDoc.vb_Description = "保存当前文档为FileName指定文件"
On Error Resume Next
'并另存为文件FileName
If Len(C_newDoc) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Sub
End If
mywdapp.ActiveDocument.SaveAs (C_newDoc)
If Err.Number <> 0 Then
C_ErrMsg = 3
RaiseEvent HaveError
Exit Sub
End If
End Sub
Public Property Get TemplateDoc() As String
Attribute TemplateDoc.vb_Description = "模板文件名."
TemplateDoc = C_TemplateDoc
End Property
Public Property Let TemplateDoc(ByVal vNewValue As String)
C_TemplateDoc = vNewValue
End Property
Public Property Get newdoc() As String
Attribute newdoc.vb_Description = "执行CloseDoc方法时,将模板文件另存为此文件名指定的新文件.如果不指定,在执行CloseDoc方法时,将产生一个错误"
newdoc = C_newDoc
End Property
Public Property Let newdoc(ByVal vNewValue As String)
C_newDoc = vNewValue
End Property
Public Property Get PicFile() As String
Attribute PicFile.vb_Description = "图像文件名"
PicFile = C_PicFile
End Property
Public Property Let PicFile(ByVal vNewValue As String)
C_PicFile = vNewValue
End Property
Public Property Get ErrMsg() As Integer
Attribute ErrMsg.vb_Description = "错误信息.ErrMsg代码: 1-Word没有安装 2-缺少参数 3-没权限写文件 4-文件不存在"
ErrMsg = C_ErrMsg
End Property
- vb控制word的类模块,查找、替换Word文档内容
- vb控制word的类模块,查找、替换Word文档内容
- VB查找并替换WORD文档中的字符串
- VB打印word文件,vb查找替换word文件
- 利用Excel查找替换Word文本框里的内容
- C#实现WORD文档的内容复制和替换
- asp.net访问word的类,有你需要的替换,查找,表格很多功能!vb
- Word 2007 POI 替换文档内容
- word的高级查找替换
- VB控制Word文档实例精选一
- VB控制Word文档实例精选二
- Jacob控制word文档拷贝段落内容
- 巧用Word - 在Word中使用下拉菜单控制文档的可视内容
- java poi组件 读取word文档 替换文档 内容 图片
- word查找替换图片
- Word 查找替换
- VB打开Word文档
- Docx4j替换word文档的页眉
- VB中给listview的item添加多行气泡式Tooltip
- 多级联动下拉选择框,动态获取下一级
- RFC1928
- 使用XSLT将XML数据转换成HTML
- XML文档搜索使用小结
- vb控制word的类模块,查找、替换Word文档内容
- 概述IE和SQL2k开发一个XML聊天程序
- 98/ME下实现文件夹的共享和删除共享
- 如何得到XML文档大小
- 用 VB 创建MS OFFICE的 COM 加载项
- HTML中的XML数据岛记录编辑与添加
- 自己动手做个MSN信息群发软件
- 使用JavaScript访问XML数据
- 如何用VB编写你自己的MSN即时通讯软件