程式騎兵

實際運作擷圖

第一次在部落格中記錄 VBA 程式，因為最近有個需求，來源是客戶每週有個重要任務：整理公司的生產統計資料並產生多種不同圖表於 Weekly review會議中報告，而這些圖表包含有 Pie、Line圖等。
客戶久而久之發現整理這些資料很花時間，重覆性很高，聽別人說有 Excel VBA ，可以將原本手動的工作改為程式處理，以後只要執行程式就可以自動產生出圖表。沒錯，這個客戶的觀念非常正確，Excel VBA 就是這樣好用，如果你是Excel的重度使用者，常常有一些計算或是統計的任務或許可以考慮將這些工作交由程式處理，以自動化的方式處理。那你省下來的時間呢？當然是去作更重要的事情啦！
 

以下是這次 VBA 的部份程式，我擷取部份精華下來作為記錄也分享給大家。


第1部份：原始資料(Raw data) 產生樞紐分析表
'=====================================================
'2.Create Pivot table
'=====================================================
'Where do you want Pivot Table to start?
StartPvt = shtName & "!" & Range("A2").Address(ReferenceStyle:=xlR1C1)
'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData)
'Create Pivot table from Pivot Cache
Set PT = pvtCache.CreatePivotTable(TableDestination:=StartPvt, TableName:="PivotTable" & shtName)
  
'在新的PivotTable上設置欄位
With PT
'欄
    .PivotFields("Region").Orientation = xlRowField
'資料
    .PivotFields("NO").Orientation = xlDataField
'可以設定各欄位的顯示與否
    With .PivotFields("Page Two.RMA Region")
        .PivotItems("(blank)").Visible = False
    End With
End With
'建立樞紐分析表會顯示出其命令列, 關掉它
Application.CommandBars("PivotTable").Visible = False
第2部份：樞紐分析表轉為 Pie 圖表
'=====================================================
'3.Create Chart
'=====================================================
Set objChart = Charts.Add
With objChart
    .ChartType = xlPie
    .SetSourceData Source:=Sheets(shtName).Range, PlotBy:=xlColumns
    .Location Where:=xlLocationAsObject, Name:=shtName
End With
'Chart 定位, 大小
With ActiveChart.Parent
    .Left = 200
    .Top = 50
    .Width = 450
    .Height = 350
End With
'DataLabel 及 Title
With ActiveChart
    .HasTitle = True
    .ChartTitle.Text = "By Region"
    .ApplyDataLabels xlDataLabelsShowPercent
    .SeriesCollection(1).DataLabels.NumberFormat = "##0.00%"
End With
第3部份：Pie 圖表匯出到 PowerPoint，以下這段程式碼是由 G 大神來的
Sub ChartsToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPT As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With
Next
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub

完整程式及測試檔案
https://drive.google.com/open?id=0B0pY4dpq6q9WZVZtZ21fbWNfMEU