在VB60中指定位置插入文字Word文件下载.docx
《在VB60中指定位置插入文字Word文件下载.docx》由会员分享,可在线阅读,更多相关《在VB60中指定位置插入文字Word文件下载.docx(8页珍藏版)》请在冰豆网上搜索。
AttributeVB_Exposed=False
PrivatemywdappAsWord.Application
PrivatemyselAsObject
'
属性值的模块变量
PrivateC_TemplateDocAsString
PrivateC_newDocAsString
PrivateC_PicFileAsString
PrivateC_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)=0Then
C_ErrMsg=2
ExitFunction
EndIf
DimiAsInteger
DimfindtxtAsBoolean
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
Withmysel.Find
.Text=FindStr
.Replacement.Text="
"
.Forward=True
.Wrap=wdFindContinue
.Format=False
.MatchCase=False
.MatchWholeWord=False
.MatchByte=True
.MatchWildcards=False
.MatchSoundsLike=False
.MatchAllWordForms=False
EndWith
mysel.HomeKeyUnit:
=wdStory
findtxt=mysel.Find.Execute(Replace:
=True)
IfNotfindtxtThen
ReplacePic=0
i=1
DoWhilefindtxt
mysel.InlineShapes.AddPictureFileName:
=C_PicFile
Ifi=TimeThenExitDo
i=i+1
Loop
ReplacePic=i
EndFunction
PublicFunctionFindThis(FindStrAsString)AsBoolean
AttributeFindThis.VB_Description="
查找FindStr,如果模板中有FindStr则返回True"
IfLen(FindStr)=0Then
FindThis=mysel.Find.Execute
PublicFunctionReplaceChar(FindStrAsString,RepStrAsString,OptionalTimeAsInteger=0)AsInteger
AttributeReplaceChar.VB_Description="
查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时,替换所有"
从Word.Range对象mysel中查找FindStr,并替换为RepStr
RaiseEventHaveError
.Replacement.Text=RepStr
IfTime>
0Then
Fori=1ToTime
=wdReplaceOne)
IfNotfindtxtThenExitFor
Next
Ifi=1AndNotfindtxtThen
ReplaceChar=0
Else
ReplaceChar=i
mysel.Find.ExecuteReplace:
=wdReplaceAll
PublicFunctionGetPic(PicData()AsByte,FileNameAsString)AsBoolean
AttributeGetPic.VB_Description="
把图像数据PicData,存为PicFile指定的文件"
把图像数据PicData,存为PicFile指定的文件
OnErrorResumeNext
IfLen(FileName)=0Then
OpenFileNameForBinaryAs#1
IfErr.Number<
>
C_ErrMsg=3
二进制文件用Get,Put存放,读取数据
Put#1,,PicData
Close#1
C_PicFile=FileName
GetPic=True
PublicSubDeleteToEnd()
AttributeDeleteToEnd.VB_Description="
删除从当前位置到结尾的所有内容"
mysel.EndKeyUnit:
=wdStory,Extend:
=wdExtend
mysel.DeleteUnit:
=wdCharacter,Count:
=1
EndSub
PublicSubMoveEnd()
AttributeMoveEnd.VB_Description="
光标移动到文档结尾"
光标移动到文档结尾
PublicSubGotoLine(LineTimeAsInteger)
mysel.GoToWhat:
=wdGoToLine,Which:
=wdGoToFirst,Count:
=LineTime,Name:
="
PublicSubOpenDoc(viewAsBoolean)
AttributeOpenDoc.VB_Description="
打开Word文件,View确定是否显示Word界面"
打开Word文件,并给全局变量mysel赋值
IfLen(C_TemplateDoc)=0Then
mywdapp.Documents.Add
mywdapp.Documents.Open(C_TemplateDoc)
C_ErrMsg=4
ExitSub
mywdapp.Visible=view
mywdapp.Activate
Setmysel=mywdapp.Application.Selection
mysel.Select
PublicSubOpenWord()
打开Word程序,并给全局变量mywdapp赋值
Setmywdapp=CreateObject("
word.application"
)
C_ErrMsg=1
PublicSubViewDoc()
AttributeViewDoc.VB_Description="
显示Word程序界面"
mywdapp.Visible=True
PublicSubAddNewPage()
AttributeAddNewPage.VB_Description="
插入分页符"
mysel.InsertBreakType:
=wdPageBreak
PublicSubWordCut()
AttributeWordCut.VB_Description="
剪切模板所有内容到剪切板"
保存模板页面内容
mysel.WholeStory
mysel.Cut
PublicSubWordCopy()
AttributeWordCopy.VB_Description="
拷贝模板所有内容到剪切板"
mysel.Copy
PublicSubWordDel()
mysel.Delete
PublicSubWordPaste()
AttributeWordPaste.VB_Description="
拷贝剪切板内容到当前位置"
插入模块内容
mysel.Paste
PublicSubCloseDoc()
AttributeCloseDoc.VB_Description="
关闭Word文件模板"
关闭Word文件模本
mywdapp.ActiveDocument.CloseFalse
PublicSubQuitWord()
关闭Word程序
mywdapp.Quit
PublicSubSavetoDoc()
AttributeSavetoDoc.VB_Description="
保存当前文档为FileName指定文件"
并另存为文件FileName
IfLen(C_newDoc)=0Then
mywdapp.ActiveDocument.SaveAs(C_newDoc)
PublicPropertyGetTemplateDoc()AsString
AttributeTemplateDoc.VB_Description="
模板文件名."
TemplateDoc=C_TemplateDoc
EndProperty
PublicPropertyLetTemplateDoc(ByValvNewValueAsString)
C_TemplateDoc=vNewValue
PublicPropertyGetnewdoc()AsString
Attributenewdoc.VB_Description="
执行CloseDoc方法时,将模板文件另存为此文件名指定的新文件.如果不指定,在执行CloseDoc方法时,将产生一个错误"
newdoc=C_newDoc
PublicPropertyLetnewdoc(ByValvNewValueAsString)
C_newDoc=vNewValue
PublicPropertyGetPicFile()AsString
AttributePicFile.VB_Description="
图像文件名"
PicFile=C_PicFile
PublicPropertyLetPicFile(ByValvNewValueAsString)
C_PicFile=vNewValue
PublicPropertyGetErrMsg()AsInteger
AttributeErrMsg.VB_Description="
错误信息.ErrMsg代码:
1-word没有安装2-缺少参数3-没权限写文件4-文件不存在"
ErrMsg=C_ErrMsg