VB操作word总结.docx
- 文档编号:3516848
- 上传时间:2022-11-23
- 格式:DOCX
- 页数:12
- 大小:20.54KB
VB操作word总结.docx
《VB操作word总结.docx》由会员分享,可在线阅读,更多相关《VB操作word总结.docx(12页珍藏版)》请在冰豆网上搜索。
VB操作word总结
请耐心看完:
问题出现得较复杂。
我的目的:
将多个文档内容逐一拷贝粘贴到另一文档后面
我的方法:
wordapp=new word.application
Set doc = wordapp.Documents.Add
while
pathTemp = App.Path & "\temp.doc"
LoadFile rs("word"), pathTemp
Set doctemp = wordapp.Documents.Open(pathTemp)
doctemp.Content.Select
wordapp.Selection.copy
Set myRange = doc.Range(Start:
=doc.Content.End - 1, End:
=doc.Content.End)
myRange.Select
' wordapp.Selection.delete
wordapp.Selection.InsertParagraphBefore
wordapp.Selection.Collapse wdCollapseEnd
wordapp.Selection.paste
Clipboard.Clear
doctemp.Close wdDoNotSaveChanges
doc.SaveAs App.Path & "\papertemp.doc"
如果我的文档(待拷贝的文档,这些文档都是从数据库中读出来的,存在pathTemp文件中)都较小的话,我的程序可以顺利完成任务,如果其中一个文档较大,那么问题出现了,但是问题不是马上出现,该文档的内容能顺利从数据库下载到文件pathTemp中,也能打开到doctemp中,复制粘贴到doc中也没有问题,但是关闭doctemp时却发现隐藏的~$temp.doc并没有消失(意味着doctemp并没有关闭?
),接着我把下一个文档从数据库读出放到doctemp中也能完成,temp.doc中内容正确,但是当我用Set doctemp = wordapp.Documents.Open(pathTemp)打开时却出现了问题,
运行时错误 ‘5121’
文档的名称或路径无效,请使用如下建议:
....
手动打开temp.doc也出现同样的错误,但是当我关掉doc(即papertemp.doc)时,打开temp.doc却是正常,而且里面数据也正常
请高手指教,愿送所有分问题点数:
100、回复次数:
8Top
1楼faysky2(出来混,迟早是要还嘀)回复于2005-10-2601:
19:
45得分4
是着释放doctemp 看看:
....
Clipboard.Clear
doctemp.Close wdDoNotSaveChanges
doc.SaveAs App.Path & "\papertemp.doc"
Set doctemp=Nothing'--->释放掉doctemp
Top
2楼hapluo(言先必行,多说无益)回复于2005-10-2620:
49:
54得分0
还是不行,
哪位高手帮我解决,另送200分Top
3楼hapluo(言先必行,多说无益)回复于2005-10-2620:
56:
53得分0
这个号所有分相送,这个号就剩500分了,数来帮我啊,
分不够我另外一个号还可再加!
Top
4楼hapluo(言先必行,多说无益)回复于2005-10-2621:
28:
55得分0
help,Top
5楼mylord()回复于2005-10-2621:
55:
46得分2
正在学习中...Top
6楼northwolves(狼行天下)回复于2005-10-2623:
46:
20得分90
何必打开,直接合并不行?
试试:
Private Sub Command1_Click()
Dim wordapp As New Word.application, doc As New Document, pathtemp As String
Set doc = wordapp.Documents.Open(App.Path & "\papertemp.doc")
doc.Content.Select
Do While Not rs.EOF
pathtemp = App.Path & "\temp.doc"
LoadFile rs("word"), pathtemp'你写的过程吧
With wordapp.selection
.InsertFile FileName:
=pathtemp, ConfirmConversions:
=False
.InsertParagraphAfter
.InsertBreak Type:
=wdSectionBreakNextPage
.Collapse Direction:
=wdCollapseEnd
End With
Kill pathtemp
rs.movenext
Loop
doc.Save
End If
Top
7楼faysky2(出来混,迟早是要还嘀)回复于2005-10-2623:
48:
40得分4
把doc也关掉试试:
.....
Clipboard.Clear
doctemp.Close wdDoNotSaveChanges
doc.SaveAs App.Path & "\papertemp.doc"
doctemp.Quit
doc.Quit
Set doc=NothingTop
8楼hapluo(言先必行,多说无益)回复于2005-10-2700:
57:
23得分0
northwolves(狼行天下) ,非常感谢,虽然没有问题之所在,但是绕开了问题相当于解决了问题,再次感谢!
有什么办法可以把分一下相送,以示感激之情?
除了多开几贴还有其他办法嘛?
vb控制word的类模块,查找、替换Word文档内容
在VB6.0中,操作word,使用它强大的查找、替换、删除、复制、翦切功能。
还可以把特定字符替换成图片。
有了它你就可以使用数据库中的内容或图片文件替换word文件中的特定字符。
只要把下列内容复制到写字板中,另存为SetWord.cls文件,然后在把它添加到工程中,就可以使用了。
VERSION1.0CLASS
BEGIN
MultiUse=-1 'True
Persistable=0 'NotPersistable
DataBindingBehavior=0 'vbNone
DataSourceBehavior =0 'vbNone
MTSTransactionMode =0 'NotAnMTSObject
END
AttributeVB_Name="SetWord"
AttributeVB_GlobalNameSpace=False
AttributeVB_Creatable=True
AttributeVB_PredeclaredId=False
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
ExitFunction
EndIf
i=1
DoWhilefindtxt
mysel.InlineShapes.AddPictureFileName:
=C_PicFile
Ifi=TimeThenExitDo
i=i+1
mysel.HomeKeyUnit:
=wdStory
findtxt=mysel.Find.Execute(Replace:
=True)
Loop
ReplacePic=i
EndFunction
PublicFunctionFindThis(FindStrAsString)AsBoolean
AttributeFindThis.VB_Description="查找FindStr,如果模板中有FindStr则返回True"
IfLen(FindStr)=0Then
C_ErrMsg=2
ExitFunction
EndIf
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
FindThis=mysel.Find.Execute
EndFunction
PublicFunctionReplaceChar(FindStrAsString,RepStrAsString,OptionalTimeAsInteger=0)AsInteger
AttributeReplaceChar.VB_Description="查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时,替换所有"
'********************************************************************************
' 从Word.Range对象mysel中查找FindStr,并替换为RepStr
' 替换次数由time参数确定,为0时,替换所有
'********************************************************************************
DimfindtxtAsBoolean
IfLen(FindStr)=0Then
C_ErrMsg=2
RaiseEventHaveError
ExitFunction
EndIf
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
Withmysel.Find
.Text=FindStr
.Replacement.Text=RepStr
.Forward=True
.Wrap=wdFindContinue
.Format=False
.MatchCase=False
.MatchWholeWord=False
.MatchByte=True
.MatchWildcards=False
.MatchSoundsLike=False
.MatchAllWordForms=False
EndWith
IfTime>0Then
Fori=1ToTime
mysel.HomeKeyUnit:
=wdStory
findtxt=mysel.Find.Execute(Replace:
=wdReplaceOne)
IfNotfindtxtThenExitFor
Next
Ifi=1AndNotfindtxtThen
ReplaceChar=0
Else
ReplaceChar=i
EndIf
Else
mysel.Find.ExecuteReplace:
=wdReplaceAll
EndIf
EndFunction
PublicFunctionGetPic(PicData()AsByte,FileNameAsString)AsBoolean
AttributeGetPic.VB_Description="把图像数据PicData,存为PicFile指定的文件"
'********************************************************************************
' 把图像数据PicData,存为PicFile指定的文件
'********************************************************************************
OnErrorResumeNext
IfLen(FileName)=0Then
C_ErrMsg=2
RaiseEventHaveError
ExitFunction
EndIf
OpenFileNameForBinaryAs#1
IfErr.Number<>0Then
C_ErrMsg=3
ExitFunction
EndIf
'二进制文件用Get,Put存放,读取数据
Put#1,,PicData
Close#1
C_PicFile=FileName
GetPic=True
EndFunction
PublicSubDeleteToEnd()
AttributeDeleteToEnd.VB_Description="删除从当前位置到结尾的所有内容"
mysel.EndKeyUnit:
=wdStory,Extend:
=wdExtend
mysel.DeleteUnit:
=wdCharacter,Count:
=1
EndSub
PublicSubMoveEnd()
AttributeMoveEnd.VB_Description="光标移动到文档结尾"
'光标移动到文档结尾
mysel.EndKeyUnit:
=wdStory
EndSub
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)=0Then
mywdapp.Documents.Add
Else
mywdapp.Documents.Open(C_TemplateDoc)
EndIf
IfErr.Number<>0Then
C_ErrMsg=4
RaiseEventHaveError
ExitSub
EndIf
mywdapp.Visible=view
mywdapp.Activate
Setmysel=mywdapp.Application.Selection
'mysel.Select
EndSub
PublicSubOpenWord()
OnErrorResumeNext
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 操作 word 总结