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