在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 = 光标移动到文档结尾光标移动到文档结尾mysel.EndKey Unit:=wdStoryEnd SubPublic Sub GotoLine