版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领
文档简介
本文格式为Word版,下载可任意编辑——在VB60中指定位置插入文字在VB6.0中,操作word,使用它强大的查找、替换、删除、复制、翦切功能。还可以把特定字符替换成图片。有了它你就可以使用数据库中的内容或图片文件替换word文件中的特定字符。
只要把以下内容复制到写字板中,另存为SetWord.cls文件,然后在把它添加到工程中,就可以使用了。
VERSION1.0CLASSBEGIN
MultiUse=-1'True
Persistable=0'NotPersistableDataBindingBehavior=0'vbNoneDataSourceBehavior=0'vbNone
MTSTransactionMode=0'NotAnMTSObjectEND
AttributeVB_Name=\AttributeVB_GlobalNameSpace=FalseAttributeVB_Creatable=TrueAttributeVB_PredeclaredId=FalseAttributeVB_Exposed=FalsePrivatemywdappAsWord.ApplicationPrivatemyselAsObject
'属性值的模块变量
PrivateC_TemplateDocAsStringPrivateC_newDocAsStringPrivateC_PicFileAsStringPrivateC_ErrMsgAsInteger
PublicEventHaveError()
AttributeHaveError.VB_Description=\出错时激发此事件.出错代码为ErrMsg属性\'***************************************************************'ErrMsg代码:1-word没有安装2-缺少参数3-没权限写文件'4-文件不存在'
'***************************************************************
PublicFunctionReplacePic(FindStrAsString,OptionalTimeAsInteger=0)AsInteger
AttributeReplacePic.VB_Description=\查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时,替换所有\
'********************************************************************************'从Word.Range对象mysel中查找所有FindStr,并替换为PicFile图像'替换次数由time参数确定,为0时,替换所有
'********************************************************************************
IfLen(C_PicFile)=0ThenC_ErrMsg=2ExitFunctionEndIf
DimiAsIntegerDimfindtxtAsBoolean
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormattingWithmysel.Find.Text=FindStr.Replacement.Text=\.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWith
mysel.HomeKeyUnit:=wdStory
findtxt=mysel.Find.Execute(Replace:=True)IfNotfindtxtThenReplacePic=0ExitFunctionEndIfi=1
DoWhilefindtxt
mysel.InlineShapes.AddPictureFileName:=C_PicFileIfi=TimeThenExitDoi=i+1
mysel.HomeKeyUnit:=wdStory
findtxt=mysel.Find.Execute(Replace:=True)Loop
ReplacePic=iEndFunction
PublicFunctionFindThis(FindStrAsString)AsBoolean
AttributeFindThis.VB_Description=\查找FindStr,假使模板中有FindStr则返回True\IfLen(FindStr)=0ThenC_ErrMsg=2ExitFunctionEndIf
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormattingWithmysel.Find.Text=FindStr.Replacement.Text=\.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWith
mysel.HomeKeyUnit:=wdStoryFindThis=mysel.Find.ExecuteEndFunction
PublicFunctionReplaceChar(FindStrAsString,RepStrAsString,OptionalTimeAsInteger=0)AsInteger
AttributeReplaceChar.VB_Description=\查找FindStr,并替换为RepStr,替换次数由time
参数确定,为0时,替换所有\
'********************************************************************************'从Word.Range对象mysel中查找FindStr,并替换为RepStr'替换次数由time参数确定,为0时,替换所有
'********************************************************************************DimfindtxtAsBoolean
IfLen(FindStr)=0ThenC_ErrMsg=2RaiseEventHaveErrorExitFunctionEndIf
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormattingWithmysel.Find.Text=FindStr
.Replacement.Text=RepStr.Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=True.MatchWildcards=False.MatchSoundsLike=False.MatchAllWordForms=FalseEndWith
IfTime>0ThenFori=1ToTime
mysel.HomeKeyUnit:=wdStory
findtxt=mysel.Find.Execute(Replace:=wdReplaceOne)IfNotfindtxtThenExitForNext
Ifi=1AndNotfindtxtThenReplaceChar=0Else
ReplaceChar=iEndIfElse
mysel.Find.ExecuteReplace:=wdReplaceAllEndIfEndFunction
PublicFunctionGetPic(PicData()AsByte,FileNameAsString)AsBooleanAttributeGetPic.VB_Description=\把图像数据PicData,存为PicFile指定的文件\'********************************************************************************'把图像数据PicData,存为PicFile指定的文件
'********************************************************************************OnErrorResumeNext
IfLen(FileName)=0ThenC_ErrMsg=2RaiseEventHaveErrorExitFunctionEndIf
OpenFileNameForBinaryAs#1
IfErr.Number0ThenC_ErrMsg=3ExitFunctionEndIf
'二进制文件用Get,Put存放,读取数据Put#1,,PicDataClose#1
C_PicFile=FileNameGetPic=True
EndFunction
PublicSubDeleteToEnd()
AttributeDeleteToEnd.VB_Description=\删除从当前位置到结尾的所有内容\
mysel.EndKeyUnit:=wdStory,Extend:=wdExtendmysel.DeleteUnit:=wdCharacter,Count:=1EndSub
PublicSubMoveEnd()
AttributeMoveEnd.VB_Description=\光标移动到文档结尾\'光标移动到文档结尾mysel.EndKeyUnit:=wdStoryEndSub
PublicSubGotoLine(LineTimeAsInteger)
mysel.GoToWhat:=wdGoToLine,Which:=wdGoToFirst,Count:=LineTime,Name:=\EndSub
PublicSubOpenDoc(viewAsBoolean)
AttributeOpenDoc.VB_Description=\开启Word文件,View确定是否显示Word界面\OnErrorResumeNext
'********************************************************************************'开启Word文件,并给全局变量mysel赋值
'********************************************************************************
IfLen(C_TemplateDoc)=0Thenmywdapp.Documents.AddElse
mywdapp.Documents.Open(C_TemplateDoc)EndIf
IfErr.Number0ThenC_ErrMsg=4RaiseEventHaveErrorExitSubEndIf
mywdapp.Visible=viewmywdapp.Activate
Setmysel=mywdapp.Application.Selection'mysel.Select
EndSub
PublicSubOpenWord()OnErrorResumeNext
'********************************************************************************'打开Word程序,并给全局变量mywdapp赋值
'********************************************************************************
Setmywdapp=CreateObject(\IfErr.Number0ThenC_ErrMsg=1RaiseEventHaveErrorExitSubEndIfEndSub
PublicSubViewDoc()
AttributeViewDoc.VB_Description=\显示Word程序界面\mywdapp.Visible=TrueEndSub
PublicSubAddNewPage()
AttributeAddNewPage.VB_Description=\插入分页符\mysel.InsertBreakType:=wdPageBreakEndSub
PublicSubWordCut()
AttributeWordCut.VB_Description=\剪切模板所有内容到剪切板\'保存模板页面内容mysel.WholeStorymysel.Cut
mysel.HomeKeyUnit:=wdStoryEndSub
PublicSubWordCopy()
AttributeWordCopy.VB_Description=\拷贝模板所有内容到剪切板\
mysel.WholeStorymysel.Copy
mysel.HomeKeyUnit:=wdStoryEndSub
PublicSubWordDel()mysel.WholeStorymysel.Delete
mysel.HomeKeyUnit:=wdStoryEndSub
PublicSubWordPaste()
AttributeWordPaste.VB_Description=\拷贝剪切板内容到当前位置\'插入模块内容mysel.PasteEndSub
PublicSubCloseDoc()
AttributeCloseDoc.VB_Description=\关闭Word文件模板\
'********************************************************************************'关闭Word文件模本
'********************************************************************************OnErrorResumeNext
mywdapp.ActiveDocument.CloseFalse
IfErr.Number0ThenC_ErrMsg=3ExitSubEndIfEndSub
PublicSubQuitWord()
'********************************************************************************'关闭Word程序
'********************************************************************************OnErrorResumeNext
mywdapp.Quit
IfErr.Number0ThenC_ErrMsg=3ExitSubEndIfEndSub
PublicSubSavetoDoc()
AttributeSavetoDoc.VB_Description=\保存当前文档为FileName指定文件\OnErrorResumeNext
'并另存为文件FileName
IfLen(C_newDoc)=0ThenC_ErrMsg=2RaiseEventHaveErrorExitSubEndIf
mywdapp.ActiveDocument.SaveAs(C_newDoc)
IfErr.Number0ThenC_ErrMsg=3RaiseEventHaveErrorExitSubEndIfEndSub
PublicPropertyGetTemp
温馨提示
- 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
- 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
- 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
- 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
- 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
- 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
- 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- 大运河劳动合同用人单位物流2024年度智能物流系统合同
- 池塘租赁合同协议书
- 二零二四年度北京市装修工程供应链管理合同
- 二零二四年度船舶货物装卸合同
- 二零二四年度物业维修基金管理合同
- 2024年度存量房买卖合同(买卖双方身份证信息核实)
- 二零二四年货币赔偿及合同权益保障协议
- 二零二四年度艺人经纪合同范本(经纪活动范围与分成比例)
- 二零二四年度大型仓储物流搬迁合同
- 二零二四年度许可合同广播电视节目制作许可
- 集团公司企业各岗位廉洁风险点防控表格模板汇编(40篇)
- 《大学》读书题库
- 世界社会主义五百年
- 表观遗传学-课件
- 小学数学二年级上册《认识时间》单元作业设计
- 铁路道岔基础
- 新中国史(大连海事大学)智慧树知到网课章节测试答案
- 英语听力高三北师大第1-26套
- GB 31644-2018食品安全国家标准复合调味料
- 2023年学校音乐器材管理室工作总结
- 丙酮的产品包装说明和使用说明书
评论
0/150
提交评论