在VB60中指定位置插入文字Word文件下载.docx

1、Attribute VB_Exposed = FalsePrivate mywdapp As Word.ApplicationPrivate mysel As Object属性值的模块变量Private C_TemplateDoc As StringPrivate C_newDoc As StringPrivate C_PicFile As StringPrivate C_ErrMsg As IntegerPublic Event HaveError（）Attribute HaveError.VB_Description = 出错时激发此事件.出错代码为ErrMsg属性*ErrMsg代码：1w

2、ord没有安装 2 - 缺少参数 3 - 没权限写文件 4 - 文件不存在Public Function ReplacePic（FindStr As String, Optional Time As Integer = 0） As IntegerAttribute ReplacePic.VB_Description = 查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时，替换所有* 从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像 替换次数由time参数确定，为0时，替换所有If Len（C_PicFile）

3、= 0 ThenC_ErrMsg = 2Exit FunctionEnd IfDim i As IntegerDim findtxt As Booleanmysel.Find.ClearFormattingmysel.Find.Replacement.ClearFormattingWith mysel.Find.Text = FindStr.Replacement.Text = .Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = Tru

4、e.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd Withmysel.HomeKey Unit:=wdStoryfindtxt = mysel.Find.Execute（Replace:=True）If Not findtxt ThenReplacePic = 0i = 1Do While findtxtmysel.InlineShapes.AddPicture FileName:=C_PicFileIf i = Time Then Exit Doi = i + 1LoopReplaceP

5、ic = iEnd FunctionPublic Function FindThis（FindStr As String） As BooleanAttribute FindThis.VB_Description = 查找FindStr,如果模板中有FindStr则返回TrueIf Len（FindStr） = 0 ThenFindThis = mysel.Find.ExecutePublic Function ReplaceChar（FindStr As String, RepStr As String, Optional Time As Integer = 0） As IntegerAttr

6、ibute ReplaceChar.VB_Description = 查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时，替换所有 从Word.Range对象mysel中查找FindStr，并替换为RepStrRaiseEvent HaveError.Replacement.Text = RepStrIf Time 0 ThenFor i = 1 To Time=wdReplaceOne）If Not findtxt Then Exit ForNextIf i = 1 And Not findtxt ThenReplaceChar = 0ElseReplaceChar

7、 = imysel.Find.Execute Replace:=wdReplaceAllPublic Function GetPic（PicData（） As Byte, FileName As String） As BooleanAttribute GetPic.VB_Description = 把图像数据PicData,存为PicFile指定的文件 把图像数据PicData,存为PicFile指定的文件On Error Resume NextIf Len（FileName） = 0 ThenOpen FileName For Binary As #1If Err.Number C_ErrM

8、sg = 3二进制文件用Get,Put存放，读取数据Put #1, , PicDataClose #1C_PicFile = FileNameGetPic = TruePublic Sub DeleteToEnd（）Attribute DeleteToEnd.VB_Description = 删除从当前位置到结尾的所有内容mysel.EndKey Unit:=wdStory, Extend:=wdExtendmysel.Delete Unit:=wdCharacter, Count:=1End SubPublic Sub MoveEnd（）Attribute MoveEnd.VB_Descri

9、ption = 光标移动到文档结尾光标移动到文档结尾Public Sub GotoLine（LineTime As Integer）mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:=Public Sub OpenDoc（view As Boolean）Attribute OpenDoc.VB_Description = 打开Word文件,View确定是否显示Word界面 打开Word文件，并给全局变量mysel赋值If Len（C_TemplateDoc） = 0 Thenmywdapp.Docume

10、nts.Addmywdapp.Documents.Open （C_TemplateDoc）C_ErrMsg = 4Exit Submywdapp.Visible = viewmywdapp.ActivateSet mysel = mywdapp.Application.Selectionmysel.SelectPublic Sub OpenWord（） 打开Word程序，并给全局变量mywdapp赋值Set mywdapp = CreateObject（word.application）C_ErrMsg = 1Public Sub ViewDoc（）Attribute ViewDoc.VB_D

11、escription = 显示Word程序界面mywdapp.Visible = TruePublic Sub AddNewPage（）Attribute AddNewPage.VB_Description = 插入分页符mysel.InsertBreak Type:=wdPageBreakPublic Sub WordCut（）Attribute WordCut.VB_Description = 剪切模板所有内容到剪切板保存模板页面内容mysel.WholeStorymysel.CutPublic Sub WordCopy（）Attribute WordCopy.VB_Description

12、 = 拷贝模板所有内容到剪切板mysel.CopyPublic Sub WordDel（）mysel.DeletePublic Sub WordPaste（）Attribute WordPaste.VB_Description = 拷贝剪切板内容到当前位置插入模块内容mysel.PastePublic Sub CloseDoc（）Attribute CloseDoc.VB_Description = 关闭Word文件模板 关闭Word文件模本mywdapp.ActiveDocument.Close FalsePublic Sub QuitWord（） 关闭Word程序mywdapp.QuitP

13、ublic Sub SavetoDoc（）Attribute SavetoDoc.VB_Description = 保存当前文档为FileName指定文件并另存为文件FileNameIf Len（C_newDoc） = 0 Thenmywdapp.ActiveDocument.SaveAs （C_newDoc）Public Property Get TemplateDoc（） As StringAttribute TemplateDoc.VB_Description = 模板文件名.TemplateDoc = C_TemplateDocEnd PropertyPublic Property L

14、et TemplateDoc（ByVal vNewValue As String）C_TemplateDoc = vNewValuePublic Property Get newdoc（） As StringAttribute newdoc.VB_Description = 执行CloseDoc方法时，将模板文件另存为此文件名指定的新文件.如果不指定，在执行CloseDoc方法时，将产生一个错误newdoc = C_newDocPublic Property Let newdoc（ByVal vNewValue As String）C_newDoc = vNewValuePublic Prop

15、erty Get PicFile（） As StringAttribute PicFile.VB_Description = 图像文件名PicFile = C_PicFilePublic Property Let PicFile（ByVal vNewValue As String）C_PicFile = vNewValuePublic Property Get ErrMsg（） As IntegerAttribute ErrMsg.VB_Description = 错误信息.ErrMsg代码: 1-word没有安装 2-缺少参数 3-没权限写文件 4-文件不存在ErrMsg = C_ErrMsg