版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领
文档简介
本文格式为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. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- GB/T 9445-2024无损检测人员资格鉴定与认证
- 保证保险行业经营分析报告
- 个人背景调查行业市场调研分析报告
- 玩具箱家具市场分析及投资价值研究报告
- 衬裙项目运营指导方案
- 自行车脚踏车轮圈市场分析及投资价值研究报告
- 回热式换热器产品供应链分析
- 空白盒式录像带产品供应链分析
- 公共关系传播策略咨询行业经营分析报告
- 医疗设备租赁行业经营分析报告
- 人工智能智慧树知到答案章节测试2023年复旦大学
- JJG 852-2019中子周围剂量当量(率)仪
- GB/T 32131-2015辣根过氧化物酶活性检测方法比色法
- GB/T 12755-2008建筑用压型钢板
- GB 31644-2018食品安全国家标准复合调味料
- 沙盘游戏心理治疗培训课件
- 2022高中学业水平考试信息技术会考知识点归纳总结(复习必背)
- 2022秋国开公共关系学形考任务3试题及答案
- 部编版三年级语文(上册)标点符号专项训练题(含答案)
- 对外汉语教学趋向补语练习题
- 油茶栽培(普通油茶)课件
评论
0/150
提交评论