VB操作word总结_vb操作word总结

2020-02-28 其他工作总结下载本文

VB操作word总结由刀豆文库小编整理，希望给你工作、学习、生活带来方便，猜你可能喜欢“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 缺少参数 3文件不存在 ' '*************************************************************** Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0)As Integer Attribute ReplacePic.VB_Description = “查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时，替换所有” '******************************************************************************** '

从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像 ' 替换次数由time参数确定，为0时，替换所有

'******************************************************************************** If Len(C_PicFile)= 0 Then C_ErrMsg = 2 Exit Function End If Dim i As Integer Dim findtxt As Boolean mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = “”.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=True)If Not findtxt Then ReplacePic = 0 Exit Function End If i = 1 Do While findtxt mysel.InlineShapes.AddPicture FileName:=C_PicFile If i = Time Then Exit Do i = i + 1 mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=True)Loop ReplacePic = i End Function Public Function FindThis(FindStr As String)As Boolean Attribute FindThis.VB_Description = “查找FindStr,如果模板中有FindStr则返回True” If Len(FindStr)= 0 Then C_ErrMsg = 2 Exit Function End If mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = “”.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With mysel.HomeKey Unit:=wdStory FindThis = mysel.Find.Execute End Function Public Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0)As Integer Attribute ReplaceChar.VB_Description = “查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时，替换所有” '******************************************************************************** '

从Word.Range对象mysel中查找FindStr，并替换为RepStr ' 替换次数由time参数确定，为0时，替换所有

'******************************************************************************** Dim findtxt As Boolean If Len(FindStr)= 0 Then C_ErrMsg = 2 RaiseEvent HaveError Exit Function End If mysel.Find.ClearFormatting mysel.Find.Replacement.ClearFormatting With mysel.Find.Text = FindStr.Replacement.Text = RepStr.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = False End With

If Time > 0 Then For i = 1 To Time mysel.HomeKey Unit:=wdStory findtxt = mysel.Find.Execute(Replace:=wdReplaceOne)If Not findtxt Then Exit For Next If i = 1 And Not findtxt Then ReplaceChar = 0 Else ReplaceChar = i End If Else mysel.Find.Execute Replace:=wdReplaceAll End If End Function

Public Function GetPic(PicData()As Byte, FileName As String)As Boolean Attribute GetPic.VB_Description = “把图像数据PicData,存为PicFile指定的文件” '******************************************************************************** '

把图像数据PicData,存为PicFile指定的文件

'******************************************************************************** On Error Resume Next If Len(FileName)= 0 Then C_ErrMsg = 2 RaiseEvent HaveError Exit Function End If Open FileName For Binary As #1 If Err.Number 0 Then C_ErrMsg = 3 Exit Function End If '二进制文件用Get,Put存放，读取数据 Put #1, , PicData Close #1 C_PicFile = FileName GetPic = True End Function

Public Sub DeleteToEnd()Attribute DeleteToEnd.VB_Description = “删除从当前位置到结尾的所有内容” mysel.EndKey Unit:=wdStory, Extend:=wdExtend mysel.Delete Unit:=wdCharacter, Count:=1 End Sub Public Sub MoveEnd()Attribute MoveEnd.VB_Description = “光标移动到文档结尾” '光标移动到文档结尾 mysel.EndKey Unit:=wdStory End Sub Public Sub GotoLine(LineTime As Integer)mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:=“” End Sub Public Sub OpenDoc(view As Boolean)Attribute OpenDoc.VB_Description = “打开Word文件,View确定是否显示Word界面” On Error Resume Next '******************************************************************************** '

打开Word文件，并给全局变量mysel赋值

'******************************************************************************** If Len(C_TemplateDoc)= 0 Then mywdapp.Documents.Add Else mywdapp.Documents.Open(C_TemplateDoc)End If If Err.Number 0 Then C_ErrMsg = 4 RaiseEvent HaveError Exit Sub End If

mywdapp.Visible = view mywdapp.Activate Set mysel = mywdapp.Application.Selection 'mysel.Select

End Sub Public Sub OpenWord()On Error Resume Next '******************************************************************************** '

打开Word程序，并给全局变量mywdapp赋值

'******************************************************************************** Set mywdapp = CreateObject(“word.application”)If Err.Number 0 Then C_ErrMsg = 1 RaiseEvent HaveError Exit Sub End If End Sub Public Sub ViewDoc()Attribute ViewDoc.VB_Description = “显示Word程序界面” mywdapp.Visible = True End Sub Public Sub AddNewPage()Attribute AddNewPage.VB_Description = “插入分页符” mysel.InsertBreak Type:=wdPageBreak End Sub Public Sub WordCut()Attribute WordCut.VB_Description = “剪切模板所有内容到剪切板” '保存模板页面内容 mysel.WholeStory mysel.Cut mysel.HomeKey Unit:=wdStory End Sub Public Sub WordCopy()Attribute WordCopy.VB_Description = “拷贝模板所有内容到剪切板” mysel.WholeStory mysel.Copy mysel.HomeKey Unit:=wdStory End Sub Public Sub WordDel()mysel.WholeStory mysel.Delete mysel.HomeKey Unit:=wdStory End Sub Public Sub WordPaste()Attribute WordPaste.VB_Description = “拷贝剪切板内容到当前位置” '插入模块内容 mysel.Paste End Sub Public Sub CloseDoc()Attribute CloseDoc.VB_Description = “关闭Word文件模板” '******************************************************************************** '

关闭Word文件模本 '******************************************************************************** On Error Resume Next

mywdapp.ActiveDocument.Close False If Err.Number 0 Then C_ErrMsg = 3 Exit Sub End If End Sub Public Sub QuitWord()'******************************************************************************** '

关闭Word程序

'******************************************************************************** On Error Resume Next mywdapp.Quit

If Err.Number 0 Then C_ErrMsg = 3 Exit Sub End If End Sub Public Sub SavetoDoc()Attribute SavetoDoc.VB_Description = “保存当前文档为FileName指定文件” On Error Resume Next '并另存为文件FileName If Len(C_newDoc)= 0 Then C_ErrMsg = 2 RaiseEvent HaveError Exit Sub End If mywdapp.ActiveDocument.SaveAs(C_newDoc)

If Err.Number 0 Then C_ErrMsg = 3 RaiseEvent HaveError Exit Sub End If End Sub

Public Property Get TemplateDoc()As String Attribute TemplateDoc.VB_Description = “模板文件名.” TemplateDoc = C_TemplateDoc End Property Public Property Let TemplateDoc(ByVal vNewValue As String)C_TemplateDoc = vNewValue End Property Public Property Get newdoc()As String Attribute newdoc.VB_Description = “执行CloseDoc方法时，将模板文件另存为此文件名指定的新文件.如果不指定，在执行CloseDoc方法时，将产生一个错误” newdoc = C_newDoc End Property Public Property Let newdoc(ByVal vNewValue As String)C_newDoc = vNewValue End Property Public Property Get PicFile()As String Attribute PicFile.VB_Description = “图像文件名” PicFile = C_PicFile End Property Public Property Let PicFile(ByVal vNewValue As String)C_PicFile = vNewValue End Property Public Property Get ErrMsg()As Integer Attribute ErrMsg.VB_Description = “错误信息.ErrMsg代码: 1-word没有安装 2-缺少参数 3-没权限写文件 4-文件不存在” ErrMsg = C_ErrMsg End Property 请问如何正确杀掉word进程？

楼主btl19792008（btl19792008）2005-11-04 17:05:03 在 VB / 数据库(包含打印，安装，报表)提问我的word程序运行几次，在资源管理器中就会出现很多word进程。

我的代码写的不对吗？

代码如下：

Dim appTemplate As Word.Application

Dim docTemplate As Word.Document

Set appTemplate = GetObject(, “Word.Application”)

If Err.Number = 429 Then

Set appTemplate = New Word.Application

End If

Set docTemplate = Nothing

Set appTemplate = Nothing

问题点数：100、回复次数：9Top 楼bbhere（俺是二等小兵(baby,i'll be right here waiting for you)）回复于 2005-11-04 17:31:33 得分 0 markTop楼province_（雍昊）回复于 2005-11-04 18:03:37 得分 0 要先QUIT再NOTHING。Top楼faysky2（出来混，迟早是要还嘀）回复于 2005-11-04 19:21:30 得分 0

'引用Microsoft Word X.0 Object Library

Private Sub Command1_Click()

On Error GoTo connecterr

Dim wordApp As Object

Set wordApp = CreateObject(“word.application”)

wordApp.Visible = True

Dim myDoc As Object

Set myDoc = wordApp.Documents.Open(“c:Test.dot”)

wordApp.selection.TypeText(“ Hello”)

myDoc.Close '关闭

wordApp.Quit

'退出

Set myDoc = Nothing

Set wordApp = Nothing

Exit Sub

connecterr:

End Sub

Top楼faysky2（出来混，迟早是要还嘀）回复于 2005-11-04 19:24:16 得分 0 Dim appTemplate As Word.Application

Dim docTemplate As Word.Document

Set appTemplate = GetObject(, “Word.Application”)

If Err.Number = 429 Then

Set appTemplate = New Word.Application

End If

'**************

docTemplate.Close

appTemplate.Quit

'**************

Set docTemplate = Nothing

Set appTemplate = NothingTop楼rainstormmaster（暴风雨 v2.0）回复于 2005-11-06 11:01:27 得分 0 没有office没法测试，不过我想你可以参考一下这个：

http://blog.joycode.com/mvm/archive/2004/04/25/20208.aspxTop 6 楼ahlegend（爱之传奇）回复于 2005-11-06 20:51:45 得分 0 QuitTop楼szjhxu（天野）回复于 2005-11-06 22:01:48 得分 0 Dim appTemplate As Word.Application

Dim docTemplate As Word.Document

Set appTemplate = GetObject(, “Word.Application”)

If Err.Number = 429 Then

Set appTemplate = New Word.Application

End If

appTemplate.quit

Set docTemplate = Nothing

Set appTemplate = NothingTop楼zhf_btj（闹闹）回复于 2005-11-15 21:54:47 得分 0 引用四楼

faysky2()

myDoc.Close '关闭

wordApp.Quit

'退出