Sub WordTest()
Dim objwordApp As Word.Application
Dim objword As Word.Document
Dim objSeheet As String
On Error GoTo errHandle
Sheet5.Select
strTitle = "NAMEFILE"
Range(Cells(1, 1), Cells(226, 11)).Select
Selection.Copy
Set objwordApp = New Word.Application
Set objword = objwordApp.Documents.Add
objword.Application.Visible = True
Set objSel = objword.Application.Selection
With objSel
.InsertAfter Text:=strTitle & vbCrLf
.Font.Size = 16
.InsertAfter Text:=vbCrLf
.EndKey Unit:=wdStory
.PasteExcelTable False, False, False
ThisWorkbook.Activate
Sheet5.Select
Sheet5.ChartObjects(1).CopyPicture
.Paste
End With
objword.SaveAs2 Filename:="E:/蔡金浩20150416/caijinhao.doc", FileFormat:=wdFormatDocument
objword.Close
objwordApp.Quit
errExit:
Set objSel = Nothing
Set objword = Nothing
Set objwordApp = Nothing
Exit Sub
errHandle:
MsgBox Err.Description
Resume errExit
End Sub