首页 >word操作 > 内容

【转】vb操作word

2023年1月22日 12:33
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 页


参考文章:https://blog.csdn.net/shaoz/article/details/6677909

郑重声明:本文版权归原作者所有,转载文章仅为传播更多信息之目的,如作者信息标记有误,请第一时候联系我们修改或删除,在此表示感谢。

特别提醒:

1、请用户自行保存原始数据,为确保安全网站使用完即被永久销毁,如何人将无法再次获取。

2、如果上次文件较大或者涉及到复杂运算的数据,可能需要一定的时间,请耐心等待一会。

3、请按照用户协议文明上网,如果发现用户存在恶意行为,包括但不限于发布不合适言论妄图

     获取用户隐私信息等行为,网站将根据掌握的情况对用户进行限制部分行为、永久封号等处罚。

4、如果文件下载失败可能是弹出窗口被浏览器拦截,点击允许弹出即可,一般在网址栏位置设置

5、欢迎将网站推荐给其他人,网站持续更新更多功能敬请期待,收藏网站高效办公不迷路。

      



登录后回复

共有0条评论