vb操作word

vb操作word
[追加500分求教] VB操作WORD问题
悬赏分：200 - 解决时间：2007-7-28 11:42
说明，用VB操作WORD,以下源码第一次操作完全正常，正常打开，正常替换，正常退出。进程中并没有留下windword的进
程，但第二次继续操作时就出问题，运行到ReplaceWord()就出现462错误，关闭程序重新开始又正常。请指教出错及解
决原因，追加到500分
'=============打开word==============
Function OpenWord(FileName) '打开指定word文档
Dim wordApp As New Word.Application
Dim wordDoc As New Word.Document
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False
Set wordDoc = wordApp.Documents.Open(FileName)
End Function
============替换关键字===========
Function ReplaceWord(SearchStr, ReplaceStr) '全部替换函数
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = SearchStr
.Replacement.Text = ReplaceStr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Function
'==================另存为===================
Function SaveAsWord(DiskStr, NameStr)
ChangeFileOpenDirectory DiskStr
ActiveDocument.SaveAs FileName:=NameStr, FileFormat:=wdFormatDocument _
, LockComments:=False, Password:="", AddToRecentFiles:=True, _
WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
Application.Documents.Close
Application.Quit
End Function
'===================清除对象============
Function CloseWord()
Set wordDoc = Nothing '清除文件实例
Set wordApp = Nothing '清除WORD实例
End Function
问题补充：根据《小fisher》的答案，已经解决问题，另外在SaveAsWord过程中，ChangeFileOPenDirectory DiskStr更
改为ChangeFileOpenDirectory DiskStr ，ActiveDocument.SaveAs更改为wordDoc.SaveAs，再加上原先《小fisher》提
到要更改的地方，已经完美解决，谢谢！！
PS：由于百度只能2次提高悬赏，每次50分，所以现在只有200分，未能对现500分的诺言，所以只有另开贴来加送300
分！
提问者： 有野问 - 经理五级 最佳答案
1) Function ReplaceWord(SearchStr, ReplaceStr) '全部替换函数
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.......
这个函数过程有错误！因为Selection是word的对象而不是VB的对象，所以不能在VB中直接引用，必须用
wordApp.Selection替换掉Selection才行！
这段代码在word VBA中调试不会出问题，但移植到VB中时要注意。
2)wordApp和wordDoc必须定义为全局变量，在模块公有部分使用
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
来定义
然后在OpenWord(FileName)过程中使用Set wordApp =New Word.Application
和Set wordDoc = wordApp.Documents.Open(FileName)，否则在CloseWord()过程中wordApp和wordDoc两个变量将会是未
第 1 页
vb操作word
初始化的Variant类型。
3)Function SaveAsWord(DiskStr, NameStr)中的Application须使用wordApp替换，道理同1)。
________________________________________________________________________-
网上说在Visual Basic中创建Word文档使用语句
Dim newDoc As Word.Document
Set newDoc = new Word.Document
但是VB会提示上述语句“用户定义类型未定义”
另一种创建的方法是
Dim MsWord As Object
Set MsWord = CreateObject("Word.Basic")
MsWord.AppShow
MsWord.FileNewDefault
可以创建但是下述语句没办法使用（即对该文档的一些操作）
With MsWord
.Content.Font.Name = "宋体"
.Content.Font.Size = 12
.Content.Paragraphs.LineSpacing = 15.5
End With
请教各位高手指点，我想在vb中创建一个word文档，并将程序计算的一堆结果，在该文档中按一定的格式打印出来。
另，我在word中录制了一段宏，请问在VB中如何调用，要求代码
Sub zz()
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=6, NumColumns:= _
6, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "网格型" Then
.Style = "网格型"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.TypeText Text:="1"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="2"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="5"
End sub
提问者： zhaizhaiya - 助理三级最佳答案
将
With MsWord
.Content.Font.Name = "宋体"
.Content.Font.Size = 12
.Content.Paragraphs.LineSpacing = 15.5
End With
改写为
MsWord.Content.Font.Name = "宋体"
MsWord.Content.Font.Size = 12
MsWord.Content.Paragraphs.LineSpacing = 15.5
就可以了。
_____________________________________________________________________-
用vb读word时,在程序读完,为什么还有关联,怎样给她关联除啦
悬赏分：0 - 解决时间：2008-10-23 10:06
用vb实现读word程序的操作！
也就是说当我运行vb程序时读啦一次word
第二次再执行时还是第一次的结果！
例如执行下面这个语句时：
If NewDoc.Paragraphs(1).Range.Font.Name = "新宋 体" Then s = s + 0.5
x = MsgBox("s=" + Str$(s), 64, "字体为1.5")
执行第一次之后，再改程序，执行时，总是提示word在另一个地方已经打开，实际上没有打开，我想这是由于关联的问
题！
提问者： lcs6678 - 助理二级最佳答案
在任务管理器下的进程下看看，肯定打开了。
不知道你是用什么方法定义的word对象。
如果这样定义：
Dim a As Object, b As Object, c As Object
Set a = CreateObject("word.application")
Set b = a.Documents.open("c:\1 .doc")
第 2 页
vb操作word
用以下语句关闭
b.close
a.quit
______________________________________________________________________
在VB如何存取word格式的文件
悬赏分：30 - 解决时间：2006-9-12 08:30
我想把用vb计算的一堆结果打印在word里面,并且有固定格式的简单排版,最好能在word中打印一些表格,请问用什么样的
函数或者对象实践?希望高手帮忙,要是能加一点说明,更加感激不尽
提问者： zhaizhaiya - 助理二级最佳答案
我帮你搜索到了两种方法虽然我自己也不懂但是也许你会懂吧
通过VBA进行WORD调用，要替换WORD中固定位置的值，可以事先在文档中定义标签，然后修改标签的内容即可，不用查
找。
VB中用VBA调用WORD的方法：
菜单-》工程-》引用->Microsoft Word 9.0 Object Library (后面的数字为版本号）
Dim wdApp As New Word.Application
Dim docApp As New Word.Document
具体用怎么用标签替换，可以到WORD中录制宏看看就知道了，宏可以直接在VB中通过VBA执行。
方法2
使用VB编程时，有时需要调用Microsoft Word对文字进行编辑、排版及输出。为实现这种调用，可以使用Shell函数、
OLE自动化、在包容器中嵌入Word对象等方法。经过试用和比较，总结出了这几种方法的各自特点。
1 使用Shell函数直接调用
语法：Shell (pathname[,windowstyle]).Pathname是指要执行的程序的名字和任何必须的参数或命令行开关，可以包括
目录和驱动器名；Windowstyle是执行程序的窗口风格的数字。
使用Shell调用Word比较简单，编程量小，但必须明确指定Word所在路径，这不利于移植，而且，不能对Word进行控制，
不利于程序和Word之间的数据交换。
2 使用OLE自动化控制Microsoft Word
2.1 使用方法
(1)Word为OLE自动化提供一种称为“Basic”的对象，要在VB中控制Word ,首先要定义一个引用Word中“Basic”对象的
对象变量：Dim Wordobj as Object
(2)将Word 中的“Basic”对象赋给该对象：Set Wordobj=CreateObject("Word.Basic")
(3)可以使用大多数WordBasic语句和函数控制Word或Word文档，使用方法和在Word宏中使用WordBasic指令的方法基本相
同。
(4)关闭Word:Set Wordobj =Nothing。
注意：“Basic”对象不支持关闭它自己的一个方法。即若在OLE自动化中关闭了Word，则对象被置为Nothing，便不能再
对对象进行操作，程序出错。
2.2 VB指令与WordBasic指令的差异
(1)有一些语句和函数不能使用，包括：控制结构，如While…Wend和If…Then…Else；声明语句，如Dim；定制对话框相
关的语句：FileExit语句；要求数组变量作为参数的语句或函数。
(2)也有一些指令使用方法不同。①返回字符串以一个美元符（$）结束的WordBasic函数的关键字必须括在方括号中。例
如，在WordBasic宏中的GetBookmark$()语句：mark$=GetBookmark$("Address")，若用VB调用，必须这样写
mark$=Wordobj.[Ge-tBookmark$]("Address")。②选择一个命令按钮用“True”,不选择用“False”
2.3 对OLE自动化的说明
Word可以为OLE自动化给另一个应用提供对象，但是它不能使用OLE自动化访问其它应用中的对象。例如：VB和Excel可以
使用OLE自动化访问Word，但是Word不能使用OLE自动化访问它们。
3 在包容器中嵌入Word对象
在VB中，要访问在包容器中嵌入的Word对象，首先要在项目中插入对象。做法如下：在窗体中插入OLE控件，对象类型选
择“MicrosoftWord图片”或“Microsoft Word文档”，再按“确定”。
然后用Object属性访问文档或图片，并使用WordBasic语句和函数作用于它。嵌入的对象必须在可被访问之前被激活，可
以使用Action属性激活OLE控件。例如，使用下面指令访问一个嵌入在称为OLE1的OLE控件中的文档：
Dim Wordobj as Object
OLE1.Action =7
Set Wordobj =OLE1.Object.Application. WordBasic
其他方面，使用方法同OLE自动化。使用在包容器中嵌入的Word对象，Word显示的窗口大小、位置与OLE控件定义的大
小、位置相同，而且工具栏显示位置与Word脱离。这一点与OLE自动化相比，是个不足。
总之，要想在Microsoft Visual Basic中控制Microsoft Word，最好使用OLE自动化，通过使用WordBasic指令对Word进
行全面控制，而且，用户使用起来与使用Microsoft Word一样，非常方便
___________________________________________________________________________________
用VB如何在WORD指定位置上插入文字?
悬赏分：150 - 解决时间：2006-12-6 10:21
提问者： sxtyhjh - 见习魔法师二级最佳答案
在VB6.0中，操作word，使用它强大的查找、替换、删除、复制、翦切功能。还可以把特定字符替换成图片。有了它你就
可以使用数据库中的内容或图片文件替换word文件中的特定字符。
只要把下列内容复制到写字板中，另存为SetWord.cls文件，然后在把它添加到工程中，就可以使用了。
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "SetWord"
Attribute VB_GlobalNameSpace = False
第 3 页
vb操作word
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private mywdapp As Word.Application
Private mysel As Object
'属性值的模块变量
Private C_TemplateDoc As String
Private C_newDoc As String
Private C_PicFile As String
Private C_ErrMsg As Integer
Public Event HaveError()
Attribute HaveError.VB_Description = "出错时激发此事件.出错代码为ErrMsg属性"
'***************************************************************
'ErrMsg代码：1－word没有安装 2 - 缺少参数 3 - 没权限写文件
' 4 - 文件不存在
'
'***************************************************************
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
第 4 页
vb操作word
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
第 5 页
vb操作word
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
第 6 页
vb操作word
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
第 7 页
vb操作word
'并另存为文件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
________________________________________________________________________________
用VB调用WORD
悬赏分：10 - 解决时间：2008-5-25 19:02
我在WORD里写了点东西，然后想用VB调用它，请高手指点，怎么调用这个文件，假设为help.doc
请给出原程序。
问题补充：你的代码没有问题，可不是我想要的，运行的结果只是显示了WORD内的部分内容，我想要打开WORD并显示出
来，就像正常打开WORD一样，不过这是通过代码来实现
提问者： jerryzhanzmq - 试用期一级最佳答案
那么你试一下下面的代码，是不是你所说的？？？
Private Sub Form_Load()
Dim wp As New Word.Application
Dim wd As New Word.Document
wp.Visible = True
Set wd = wp.Documents.Open("c:\22075847937.doc")
Dim neirong As String
neirong = wd.Content.Text
MsgBox "该Word文件的内容为：" & vbNewLine & neirong
End Sub
你说的只是个打开WORD文件，那么不就是个执行文件操作吗？调用shellexecute api不就行了吗！郁闷
_______________________________________________________________________________________
第 8 页