Question

高分求助：求VBA代码--EXCEL图表写入WORD

目的：在EXCEL工作表中设置一个按钮，单击就可以把EXCEL里的图表写入WORD中。
我想把Excel工作表中数据生成的图表写入到指定Word或新建Word中，以图片格式复制过去也行，请把VBA代码写一下。
只要写复制EXCEL图表到WORD这一段就好了（创建WORD及复制单元格的内容我已经搞定了，图表这一块不会，初学VBA，很多地方不懂）
目前我写的代码如下：
Sub excel写入指定word()
Dim i1 As Integer, str1 As String, arr1()
i1 = Range("C65536").End(xlUp).Row
arr1 = Range("a1:e" & i1)
str1 = ThisWorkbook.Path
Set wd = CreateObject("word.application")
wd.Visible = True
wd.Documents.Open (str1 & "\新建 Microsoft Word 文档.doc")
For i1 = 1 To UBound(arr1)
wd.Selection.TypeText Text:=Join(Application.Index(arr1, i1), "")
wd.Selection.TypeParagraph
Next
wd.ActiveDocument.Save
wd.ActiveDocument.Close
Set wd = Nothing
End Sub

帮我把EXCEL工作表中生成的图表也写入上面生成的WORD文件中。
代码整合一下，放在一起。
bigban
可不可以结合我写的这段代码，整合在一起呢？
我不想设置两段代码。

Answer 1

Sub excel写入word()
On Error Resume Next
MsgBox "请耐心等待，导出要花几分钟时间！请按确定才开始进行导出！", vbInformation, "注意"
Dim i1 As Integer, str1 As String, str2 As String, arr1()
i1 = Range("C65536").End(xlUp).Row
arr1 = Range("c1:m" & i1)
str1 = ThisWorkbook.Path
str2 = Worksheets("基础数据").Range("A2").Value

Set wd = CreateObject("word.application")
Set wddocument = wd.Documents.Add()
wd.Visible = False
wddocument.SaveAs FileName:=(str1 & "\" & str2 & ".doc")

'-----------------------标题字体格式及居中----------------------
wd.Selection.TypeText (" ")
wd.activedocument.Paragraphs(1).Range.Font.Size = 22
wd.Selection.Font.Name = "黑体"
'wd.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

For i1 = 1 To UBound(arr1)
wd.Selection.TypeText Text:=Join(Application.Index(arr1, i1), "")
wd.Selection.TypeParagraph

'-----------------------里面段落字体格式及居中----------------------

wd.Selection.Font.Name = "仿宋"
wd.Selection.Font.Size = 16
'----------------------------------------------------------------------------------------------
If i1 = 7 Then
ActiveSheet.ChartObjects("图表 1").Activate
ActiveChart.ChartArea.Copy
' ActiveWindow.Visible = False
' Windows("天天向上.xls").Activate
' Range("G3").Select
'wddocument.Application.Selection.PasteAndFormat (wdChartPicture) 'OFFICE2000以下版本不支持
wddocument.Application.Selection.Paste
i1 = 25
End If

'-----------------------------------------------------------------------------------------------

If i1 = 31 Then
ActiveSheet.ChartObjects("图表 2").Activate
ActiveChart.ChartArea.Copy
' ActiveWindow.Visible = False
'Windows("天天向上.xls").Activate
'Range("G3").Select
' wddocument.Application.Selection.PasteAndFormat (wdChartPicture)
wddocument.Application.Selection.Paste
i1 = 47
End If
'------------------------------------------------------------------------------------------
If i1 = 53 Then
ActiveSheet.ChartObjects("图表 3").Activate
ActiveChart.ChartArea.Copy
'ActiveWindow.Visible = False
Windows("天天向上.xls").Activate
Range("G3").Select
'wddocument.Application.Selection.PasteAndFormat (wdChartPicture)
wddocument.Application.Selection.Paste
i1 = 67
End If
'-----------------------------------------------------------------------------------------
Next

wd.activedocument.Save
wd.activedocument.Close
wd.Quit
Set wd = Nothing
MsgBox "导出WORD完毕！", vbInformation, "提示"

End Sub

http://zhidao.baidu.com/question/118466847.html

Answer 2

integer li_FileNum
OLEObject myword
myword = Create oleObject
li_FileNum = myword.connecttonewobject("word.Application")
if li_FileNum < 0 then
messagebox("错误","不能启动Word!")
else
myword.visible = true

myword.documents.open("c:\a.doc")

myword.application.ActiveWindow.ActivePane.View.SeekView = 9
myword.application.Selection.find.Execute("页眉设置",false,true,false,false,false,true,1,true,"王五",2)
myword.application.ActiveWindow.ActivePane.View.SeekView = 0

end if

DESTROY myword