在VB60中指定位置插入文字.docx

1、在VB60中指定位置插入文字在VB6.0中，操作word，使用它强大的查找、替换、删除、复制、翦切功能。还可以把特定字符替换成图片。有了它你就可以使用数据库中的内容或图片文件替换word文件中的特定字符。 只要把下列内容复制到写字板中，另存为SetWord.cls文件，然后在把它添加到工程中，就可以使用了。VERSION 1.0 CLASSBEGINMultiUse = -1 TruePersistable = 0 NotPersistableDataBindingBehavior = 0 vbNoneDataSourceBehavior = 0 vbNoneMTSTransactionMod

2、e = 0 NotAnMTSObjectENDAttribute VB_Name = SetWordAttribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = TrueAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalsePrivate mywdapp As Word.ApplicationPrivate mysel As Object属性值的模块变量Private C_TemplateDoc As StringPrivate C_newDoc As String

3、Private C_PicFile As StringPrivate C_ErrMsg As IntegerPublic Event HaveError()Attribute HaveError.VB_Description = 出错时激发此事件.出错代码为ErrMsg属性*ErrMsg代码：1word没有安装 2 - 缺少参数 3 - 没权限写文件 4 - 文件不存在*Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As IntegerAttribute ReplacePic.VB_Des

4、cription = 查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时，替换所有* 从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像 替换次数由time参数确定，为0时，替换所有*If Len(C_PicFile) = 0 ThenC_ErrMsg = 2Exit FunctionEnd IfDim i As IntegerDim findtxt As Booleanmysel.Find.ClearFormattingmysel.Find.Replacement.ClearFormattingWith mys

5、el.Find.Text = FindStr.Replacement.Text = .Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd Withmysel.HomeKey Unit:=wdStoryfindtxt = mysel.Find.Execute(Replace:=Tr

6、ue)If Not findtxt ThenReplacePic = 0Exit FunctionEnd Ifi = 1Do While findtxtmysel.InlineShapes.AddPicture FileName:=C_PicFileIf i = Time Then Exit Doi = i + 1mysel.HomeKey Unit:=wdStoryfindtxt = mysel.Find.Execute(Replace:=True)LoopReplacePic = iEnd FunctionPublic Function FindThis(FindStr As String

7、) As BooleanAttribute FindThis.VB_Description = 查找FindStr,如果模板中有FindStr则返回TrueIf Len(FindStr) = 0 ThenC_ErrMsg = 2Exit FunctionEnd Ifmysel.Find.ClearFormattingmysel.Find.Replacement.ClearFormattingWith mysel.Find.Text = FindStr.Replacement.Text = .Forward = True.Wrap = wdFindContinue.Format = False.

8、MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd Withmysel.HomeKey Unit:=wdStoryFindThis = mysel.Find.ExecuteEnd FunctionPublic Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0)

9、 As IntegerAttribute ReplaceChar.VB_Description = 查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时，替换所有* 从Word.Range对象mysel中查找FindStr，并替换为RepStr 替换次数由time参数确定，为0时，替换所有*Dim findtxt As BooleanIf Len(FindStr) = 0 ThenC_ErrMsg = 2RaiseEvent HaveErrorExit FunctionEnd Ifmysel.Find.ClearFormattingmysel.Find.Replacem

10、ent.ClearFormattingWith mysel.Find.Text = FindStr.Replacement.Text = RepStr.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithIf Time 0 ThenFor i = 1 To Timemys

11、el.HomeKey Unit:=wdStoryfindtxt = mysel.Find.Execute(Replace:=wdReplaceOne)If Not findtxt Then Exit ForNextIf i = 1 And Not findtxt ThenReplaceChar = 0ElseReplaceChar = iEnd IfElsemysel.Find.Execute Replace:=wdReplaceAllEnd IfEnd FunctionPublic Function GetPic(PicData() As Byte, FileName As String)

12、As BooleanAttribute GetPic.VB_Description = 把图像数据PicData,存为PicFile指定的文件* 把图像数据PicData,存为PicFile指定的文件*On Error Resume NextIf Len(FileName) = 0 ThenC_ErrMsg = 2RaiseEvent HaveErrorExit FunctionEnd IfOpen FileName For Binary As #1If Err.Number 0 ThenC_ErrMsg = 3Exit FunctionEnd If二进制文件用Get,Put存放，读取数据Pu

13、t #1, , PicDataClose #1C_PicFile = FileNameGetPic = TrueEnd FunctionPublic Sub DeleteToEnd()Attribute DeleteToEnd.VB_Description = 删除从当前位置到结尾的所有内容mysel.EndKey Unit:=wdStory, Extend:=wdExtendmysel.Delete Unit:=wdCharacter, Count:=1End SubPublic Sub MoveEnd()Attribute MoveEnd.VB_Description = 光标移动到文档结

14、尾光标移动到文档结尾mysel.EndKey Unit:=wdStoryEnd SubPublic Sub GotoLine(LineTime As Integer)mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:=End SubPublic Sub OpenDoc(view As Boolean)Attribute OpenDoc.VB_Description = 打开Word文件,View确定是否显示Word界面On Error Resume Next* 打开Word文件，并给全局变量mysel赋

15、值*If Len(C_TemplateDoc) = 0 Thenmywdapp.Documents.AddElsemywdapp.Documents.Open (C_TemplateDoc)End IfIf Err.Number 0 ThenC_ErrMsg = 4RaiseEvent HaveErrorExit SubEnd Ifmywdapp.Visible = viewmywdapp.ActivateSet mysel = mywdapp.Application.Selectionmysel.SelectEnd SubPublic Sub OpenWord()On Error Resum

16、e Next* 打开Word程序，并给全局变量mywdapp赋值*Set mywdapp = CreateObject(word.application)If Err.Number 0 ThenC_ErrMsg = 1RaiseEvent HaveErrorExit SubEnd IfEnd SubPublic Sub ViewDoc()Attribute ViewDoc.VB_Description = 显示Word程序界面mywdapp.Visible = TrueEnd SubPublic Sub AddNewPage()Attribute AddNewPage.VB_Descripti

17、on = 插入分页符mysel.InsertBreak Type:=wdPageBreakEnd SubPublic Sub WordCut()Attribute WordCut.VB_Description = 剪切模板所有内容到剪切板保存模板页面内容mysel.WholeStorymysel.Cutmysel.HomeKey Unit:=wdStoryEnd SubPublic Sub WordCopy()Attribute WordCopy.VB_Description = 拷贝模板所有内容到剪切板mysel.WholeStorymysel.Copymysel.HomeKey Unit:

18、=wdStoryEnd SubPublic Sub WordDel()mysel.WholeStorymysel.Deletemysel.HomeKey Unit:=wdStoryEnd SubPublic Sub WordPaste()Attribute WordPaste.VB_Description = 拷贝剪切板内容到当前位置插入模块内容mysel.PasteEnd SubPublic Sub CloseDoc()Attribute CloseDoc.VB_Description = 关闭Word文件模板* 关闭Word文件模本*On Error Resume Nextmywdapp.

19、ActiveDocument.Close FalseIf Err.Number 0 ThenC_ErrMsg = 3Exit SubEnd IfEnd SubPublic Sub QuitWord()* 关闭Word程序*On Error Resume Nextmywdapp.QuitIf Err.Number 0 ThenC_ErrMsg = 3Exit SubEnd IfEnd SubPublic Sub SavetoDoc()Attribute SavetoDoc.VB_Description = 保存当前文档为FileName指定文件On Error Resume Next并另存为文件

20、FileNameIf Len(C_newDoc) = 0 ThenC_ErrMsg = 2RaiseEvent HaveErrorExit SubEnd Ifmywdapp.ActiveDocument.SaveAs (C_newDoc)If Err.Number 0 ThenC_ErrMsg = 3RaiseEvent HaveErrorExit SubEnd IfEnd SubPublic Property Get TemplateDoc() As StringAttribute TemplateDoc.VB_Description = 模板文件名.TemplateDoc = C_Temp

21、lateDocEnd PropertyPublic Property Let TemplateDoc(ByVal vNewValue As String)C_TemplateDoc = vNewValueEnd PropertyPublic Property Get newdoc() As StringAttribute newdoc.VB_Description = 执行CloseDoc方法时，将模板文件另存为此文件名指定的新文件.如果不指定，在执行CloseDoc方法时，将产生一个错误newdoc = C_newDocEnd PropertyPublic Property Let newd

22、oc(ByVal vNewValue As String)C_newDoc = vNewValueEnd PropertyPublic Property Get PicFile() As StringAttribute PicFile.VB_Description = 图像文件名PicFile = C_PicFileEnd PropertyPublic Property Let PicFile(ByVal vNewValue As String)C_PicFile = vNewValueEnd PropertyPublic Property Get ErrMsg() As IntegerAttribute ErrMsg.VB_Description = 错误信息.ErrMsg代码: 1-word没有安装 2-缺少参数 3-没权限写文件 4-文件不存在ErrMsg = C_ErrMsgEnd Property