vba自動生成PPT報告？

01-12

編好VBA程序後，自動調取EXCEL中的程序在PPT裡面按照一定格式要求自動生成報告

由於我手上的office是英文版的，所以用到的都是英文功能名。抱歉。

大體上的原理就是你有一個excel表和一個ppt模板，excel里的內容拷貝去ppt里之後，先根據某頁母版進行大概的排版，然後再用vba微調

首先是準備工作，在references里選擇excel和PowerPoint object library。

然後開始寫vba，為了更好的理解，我上一段示例代碼~

『 ppApp和ppPres在宏完成後要換成object，以防其他使用者沒有啟用object library，由於採用模塊化，但是每個function都需要同樣的變數，所以設成public

Public ppApp As Powerpoint.Application

Public ppPres As Powerpoint.Presentation

Public ActFileName As Variant

Public TotalSlide As Object

Sub ExceltoPPT()

『選取ppt模板

ActFileName = Application.GetOpenFilename("microsoft powerpoint-file (*.pptx),*.ppt")

Set ppApp = CreateObject("powerPoint.Application")

"set ppApp = New powerpoint.application

ppApp.Visible = True

ppApp.Activate

Set ppPress = ppApp.Presentations.Open(ActFileName)

CreatePlan 』我把整個宏寫成模塊化的，這樣一方面防止單個function過大(excel只能跑64k的)，另一方面也方便日後維護。「CreatePlan"這個就是生成Plan這張ppt所用到的宏。

Set ppPres = Nothing

Set ppApp = Nothing

End Sub

下面是正題，如何將excel里的東西拷貝去ppt並排版

Sub CreatePlan()

ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutCustom 『在打開的ppt模板中新添加一頁

Set TotalSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)

With ppApp.ActiveWindow

.ViewType = ppViewSlide

.View.GotoSlide ppApp.ActivePresentation.Slides.Count

End With 『顯示新添加的ppt頁面，這是為了確保PowerPoint在微調格式的時候不出錯

"複製特定單元格去ppt的標題欄

TotalSlide.Shapes(1).TextFrame.TextRange.Text = Range("A1")

"複製特定單元格去ppt的副標題欄

TotalSlide.Shapes(2).TextFrame.TextRange.Text = Range("B1")

』下面是拷貝一個圖表，先選擇excel的頁，然後複製圖表並粘貼去ppt

Worksheets("plan").Activate

Worksheets("plan").Shapes.Range(Array("Plan_Chart")).Select

Selection.Copy

TotalSlide.Shapes.PasteSpecial ppPasteDefault

" 調整圖表的字型大小

ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count).Shapes(3).Chart.ChartArea.Format.TextFrame2.TextRange.Font.Size = 10

ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count).Shapes(3).Chart.Axes(xlCategory).TickLabels.Font.Size = 12

"調整圖表的字的顏色

ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count).Shapes(3).Chart.FullSeriesCollection(3).Points(7).DataLabel _