vb word生成pdf-使用VB,如何打开Word,Excel,Text,Exe,PDF,GIF 。。...

用api函数shellexecute

vb声明
declare function shellexecute lib "shell32.dll" alias "shellexecutea" (byval hwnd as long, byval lpoperation as string, byval lpfile as string, byval lpparameters as string, byval lpdirectory as string, byval nshowcmd as long) as long
说明
查找与指定文件关联在一起的程序的文件名。关联的方式要么是运行程序，要么是打印文件。可用windows注册表编辑器将特定的文件类型同应用程序关联起来。例如，扩展名为.txt的文本文件通常与windows记事本（notepad.exe）关联到一起。如在文件管理器中双击含.txt扩展名的一个文件，就会自行启动记事本程序，并在其中载入文本文件；或者将指定的文件打印出来
返回值
long，大于32表示成功
参数表 ：
参数 类型及说明
hwnd long，指定一个窗口的句柄，有些时候，windows程序有必要在创建自己的主窗口前显示一个消息框。如果发生这种情况，由这个参数指定的窗口就会作为消息框的父窗口使用。在vb环境中，通常将活动窗体的窗口句柄作为这个参数使用
lpoperation string，指定字串“open”来打开lpflie文档；或指定“print”来打印它。也可设为vbnullstring，表示默认为“open”
lpfile string，想用关联的程序打印或打开的一个程序名或文件名
lpparameters string，如lpfile是一个可执行文件，则这个字串包含了传递给执行程序的参数。如lpfile引用的是一个文档文件，或者不需要使用参数，则设为vbnullstring
lpdirectory string，想使用的默认路径完整路径
nshowcmd long，定义了如何显示启动程序的常数值。
注解
这个函数的说明在msdn里是这样的：opens or prints a specified file

转换表格的时候应该有选项的（光标一般放置在外层表格区域），如图，取消 转换嵌套表格。

当然，对于特别复杂及不规则的表格（粘贴过程中也可能导致表格错乱），用frontpage调整一下也是不错的主意。

参考文献：office xp测试

1、word对象模型层次结构

对象是 visual basic的基石，几乎在 visual basic 中的每个操作都与修改对象有关。word 的任何元素（如文档、表格、段落、域、书签等）都可以用 visual basic 中的对象来代表。

对象代表一个 word 的元素，如文档、段落、书签或单个的字符。集合也是一个对象，该对象包含其他数个对象，通常这些对象属于相同的类型，例如，一个集合对象中可包含文档中的所有书签对象。通过使用属性和方法，可以修改单个的对象，也可修改整个的对象集合。

microsoft word visual basic提供一套完整的word对象模型，这是一个以application为顶层对象的对象层次结构。

对象由两种类型的成员构成，一种是属性，第二种成员是方法。

属性是对象的一个特性或者该对象行为的一个方面。例如，文档属性包含名称、内容、保存状态以及是否启用修订。要更改一个对象的特征，可以修改其属性值。要设置一个属性的值，需在对象的后面紧接一个句点、属性名称、一个等号及新的属性值。下面的示例在"mydoc.doc"文档中启用修订。

documents("mydoc.doc").trackrevisions = true

方法是对象可以进行的动作。例如，只要文档可以打印，document 对象就具有 printout 方法。方法通常都带有参数，限定动作将如何进行。下面的示例打印活动文档的前三页。

activedocument.printout from:=1, to:=3

在大多数情况下，方法是动作，而属性是性质。使用方法将导致针对对象的某些事情发生，而使用属性则会返回对象的信息，或者引起对象的某个性质的改变。

2、document对象和documents 集合对象

在 visual basic 中，可使用 document 对象或 documents 集合对象的方法来修改文件。document 对象是本文用来创建word 文档的主要对象。

word对象模型中documents(document)对象集（或document）对象的结构如图-2所示。

其中的 paragraphs 集合对象与pagesetup对象将是下文的主角。paragraphs 集合对象是由选定内容、范围或文档中的 paragraph 对象组成的集合。pagesetup 对象代表页面设置描述。pagesetup 对象包含了文档的所有页面设置属性（左边距、下边距、纸张大小，等等）。

在熟悉了word 对象模型的基础上，我们可以使用document 对象对word 文档进行各种操作，例如：

新建一篇文档

documents 集合包含所有打开的文档。要新建一篇文档，可使用 add 方法将一个 document 对象添至 documents 集合。

新建文档的方法之一是使用add方法。add 方法将返回 document 对象，该对象引用新文档。在下面的示例中，把 add 方法返回的 document 对象赋予一个对象变量 newdoc。然后设置该 document 对象的几种属性和方法。通过 newdoc 对象变量，可以很容易地控制新文档。

set newdoc = documents.add
with newdoc
.content.font.name = "arial"
.saveas filename:="sample.doc"
end with

要把下列内容复制到写字板中，另存为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
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
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