vba word转pdf-word、excel相互打开的VBA(宏)命令,在线等!! - 百度...

dim wordobj
set wordobj = createobject("word.application")
wordobj.documents.open("c:\1.doc")'word文档路径

excel，改为excel.application即可。

private sub commandbutton1_click()

'vba工程中点工具下的引用，添加引用:micrsoft word 9.0 object library

on error resume next

dim wasolution as word.application

dim wddocument as word.document

dim strpatha as string

strpatha = "c:\1.doc"  '事先建好的指定word文档，用于保存

' macro1 macro

' 宏由 小路工作室 录制，时间: 2009-9-23

'

'

activesheet.chartobjects("图表 2").activate

activechart.chartarea.select

activechart.axes(xlvalue).majorgridlines.select

activechart.plotarea.select

activechart.chartarea.select

activechart.chartarea.copy

set wasolution = createobject("word.application")

wasolution.visible = true

wasolution.activate

wasolution.windowstate = wdwindowstatemaximize

set wddocument = wasolution.documents.add()

'wddocument.application.selection.pasteexceltable false, true, true

wddocument.application.selection.pasteandformat (wdchartpicture)

wddocument.saveas strpatha

end sub

我是使用office 2003来做的，不知道你那好使不好使
private sub commandbutton2_click()
'防止重复打开同一word文档导致错误
if not worddocisopen("f:\总工月报表.doc") then
'创建word对象
set objwordapp = createobject("word.application")
objwordapp.visible = true
'打开指定文档
set objdocument = objwordapp.documents.open("f:\总工月报表.doc")
'获取当前excel的sheet1的单元格c2数据
strname = thisworkbook.sheets(1).cells(2, 3).value
'将取得得值设定到word表格的1行2列中
objdocument.tables(1).cell(1, 2).range.text = strname
end if

end sub

'判断word文档是否被重复打开
function worddocisopen(byval strdocname as string) as boolean
dim objwordapp as object
dim objworddoc as object
worddocisopen = false
set objwordapp = nothing
on error resume next

strdocname = ucase(strdocname)
'判断是否有word程序被打开
set objwordapp = getobject(, "word.application")
if not objwordapp is nothing then
'判断指定word文件是否被打开
for each objworddoc in objwordapp.documents
if ucase(objworddoc.fullname) = strdocname then
worddocisopen = true
exit for
end if
next
end if

set objworddoc = nothing
set objwordapp = nothing
end function

sub newtextbox()
dim docnew as document
dim newtextbox as shape

'create a new document and add a text box
set docnew = documents.add
set newtextbox = docnew.shapes.addtextbox _
(orientation:=msotextorientationhorizontal, _
left:=100, top:=100, width:=300, height:=200)

'add text to the text box
newtextbox.textframe.textrange = "test"
end sub

给你段示例，你再接着完善你的：

dim wdapp as word.application '定义word对象
dim wddoc as word.document '定义word文档对象
dim wksheet as worksheet '定工作表对象
dim i as long

'实例化word对象
set wdapp = new word.application
'创建word文档
set wddoc = wdapp.documents.add
'给工作表变量赋值
set wksheet = thisworkbook.sheets("writeword")
'保存新创建的word文档
wddoc.saveas thisworkbook.path & "\test.docx"
wddoc.close '关闭新创建的word文档

with wdapp
'打开word文档
.documents.open thisworkbook.path & "\test.docx"
'循环将工作表中的记录转换为word文档内容
for i = 2 to wksheet.range("a1048576").end(xlup).row
'题头内容
.selection.typetext "亲爱的" & trim(wksheet.cells(i, 1).value)
'根据性别确定人物称呼
if wksheet.cells(i, 2).value = "男" then
.selection.typetext "先生："
else
.selection.typetext "女士："

.... .....