VBA是基于Basic语言和宿主程序（Excel、Word、Power point、Access等）的应用程序。采用VBA编写的宏(macro)工具可以进行一些重复性工作。比如可以通过宏工具从Excel文件中读取指定数据并输出到要求文件中，可以对具有某些相同特征的Excel文件进行比较、打印，可以让一大堆的图片自动生成PPT。宏，类似于dos中的批处理文件，Linux中的shell脚本，通过宏工具可以实现办公自动化，大大提高工作效率。
本文编写了一个可以将Excel中的图片(chart)复制到power point中生成PPT的宏。
功能：将Excel中的图片复制到power point中生成PPT，并对图片进行调整以适应窗口大小。
需求：
1 PPT模板文件。本例名字为template. pot，放在和宏同一级目录的文件夹下面。
2 已经生成图片的Excel文件，Excel#.xls，如第一个Excel文件名字为Excel1.xls，本例中excel文件至少有5个chart。
3 本文提供的宏程序。
PPT模板、Excel文件和包含宏程序的PPT文件在同一级目录下
步骤：
1 将power point的安全性调整为中或者低。路径：选项----安全性----宏安全性。
2 启动power point，通过：工具----宏----Visual Basic编辑器或者快捷键Alt+F8启动VB编辑器。
3 插入模块，将本文代码拷贝到模块中，保存。
4 运行宏。
'******************** Code Start **************************代码下载
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' Function: Copy chart from excel to power point.
' Vincent From www.veryword.com
Sub AutoPPT()
Dim p_path As String
p_path = ActivePresentation.Path
Dim Count As Integer
Dim k As Integer
Dim LoopName As Variant
LoopName = Array("1", "2", "3", "4", "5")
Set PPT = New PowerPoint.Application
PPT.Visible = True
Count = InputBox("Please input the number of excel files.")
Set newPres = Presentations.Add(True)
newPres.SaveAs "PPT"
For k = 1 To 5
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.Workbooks.Open (p_path & "\Excel" & Count & ".xls")
objExcel.Charts(6 - k).Activate
objExcel.activeworkbook.Save
objExcel.activeworkbook.Close
ActivePresentation.ApplyTemplate FileName:=p_path & "\template.pot"
ActivePresentation.Slides.Add 1, ppLayoutBlank
ActivePresentation.Slides(1).Select
ActiveWindow.Selection.SlideRange.Shapes.AddOLEObject(Left:=75#, Top:=125#, Width:=750#, Height:=450#, FileName:=p_path & "\Excel" & Count & ".xls", Link:=msoFalse).Select
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 0.78, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.78, msoFalse, msoScaleFromTopLeft
End With
ActiveWindow.Selection.Unselect
ActiveWindow.Selection.SlideRange.Layout = ppLayoutTitleOnly
ActiveWindow.Selection.SlideRange.Shapes.SelectAll
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = "Excel" & Count & " " & "Chart" & LoopName(5 - k)
With .Font
.NameAscii = "Arial"
.Size = 40
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppTitle
End With
End With
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=10, Length:=8).Select
ActiveWindow.Selection.TextRange.Font.Size = 40
ActiveWindow.Selection.Unselect
Next k
newPres.Save
End Sub
赞……office用到这个程度才是真正的艺术……