Powerpoint / 使用VBA建立簡報進度條

這個其實是在搜尋如何在威力導演製作影片進度條的過程中看到的教學

PowerPoint (PPT) 進度條怎麼用？教你 3 步驟做出進度列

參考了這個網站的程式碼再修改成自己想要的樣式

備註：Powerpoint VBA 沒有錄製巨集的功能，至少2016之後就沒有

#4-6 宣告一個 Presentation物件，名稱為 pp

將 Application.ActivePresentation 賦值給pp

備註：set 是給物件變數賦值 ，set不可以省略

            let 是給普通變數賦值，例如 let i =10，let可以省略

set x =range(“A1”) → x 代表 A1這個儲存格物件

(let) x =range(“A1”) ，等於x =range(“A1”).value→ x為儲存格A1的值

#10-32  透過迴圈，在每一個頁面中增加shape物件

#13 如同前面提到set的用法，這裡就是將新增的shape賦值給s來代表

Shapes.AddShape()相關的設定可以參考微軟網頁的說明

#15-24 利用with語句設定shape物件的textframe相關屬性

#26-30 設定shape物件的外框、填色、名稱

因為都是同一層的屬性，當然也可以用with語句來寫

With s
     .Line.Visible = msoFalse '取消外框
     '.Line .Weight = 2 '設定外框粗細
     .Fill.ForeColor.RGB = RGB(211, 117, 21)
     .Name = "PB"
End With

也可以把全部的shape屬性設定寫在一起

 With s
      .textframe.TextRange.Text = pp.Slides(x).SlideNumber
      .textframe.TextRange.Font.Color.RGB = RGB(0, 32, 96)
      .textframe.TextRange.Font.Size = 20
      .textframe.MarginBottom = 10
      .textframe.MarginLeft = 10
      .textframe.MarginRight = 10
      .textframe.MarginTop = 10
      .Line.Visible = msoFalse '取消外框
      '.Line .Weight = 2 '設定外框粗細
      .Fill.ForeColor.RGB = RGB(211, 117, 21)
      .Name = "PB"

End With

完整程式碼

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

Public Sub pp2()
    On Error Resume Next
    
    Dim pp As Presentation
    
    Set pp = Application.ActivePresentation
    
    Dim x As Integer
    
    For x = 1 To pp.Slides.Count
        pp.Slides(x).Shapes("PB").Delete
        
        Set s = pp.Slides(x).Shapes.AddShape(msoShapeRectangle, 0, 0, x * pp.PageSetup.SlideWidth / pp.Slides.Count, 20)
        
        With s.textframe
            .TextRange.Text = pp.Slides(x).SlideNumber
            .TextRange.Font.Color.RGB = RGB(0, 32, 96)
            .TextRange.Font.Size = 20
            .MarginBottom = 10
            .MarginLeft = 10
            .MarginRight = 10
            .MarginTop = 10
                            
        End With
        
        s.Line.Visible = msoFalse '取消外框
        's.Line .Weight = 2 '設定外框粗細
        
        s.Fill.ForeColor.RGB = RGB(211, 117, 21)
        s.Name = "PB"
        
    Next x:
    
End Sub

執行巨集之後，再逐頁撥放的效果