PPT加載宏運行教程——實現更新圖片鏈接、另存、斷開鏈接等功能

最近因為懶得手工一個個更新PPT圖表，所以設置了從Excel復制粘貼圖片鏈接到PPT的騷操作：
在Excel做好圖表→復制圖片→在PPT里“選擇性粘貼”→可以實現在打開PPT（批量更新）或者單擊鏈接圖片（單個更新）時跟Excel同步更新內容：

但是，對的，碰上了凡事都有的但是！這個騷操作留下了每次打開PPT都問“要不要更新鏈接”的毛病：

領導不滿意啊：小伙子，Macro來一下，搞定這個問題！
於是花了時間找到以下關鍵資料：

1. 更新圖片鏈接的語句：AppPPT.ActivePresentation.Slides(1).Shapes(“Chart 75”).LinkFormat.Update 和 AppPPT.ActivePresentation.Slides(1).Shapes(“Chart 75”).LinkFormat.BreakLink
2. 觸發方式一：在關閉PPT前運行程序的事件（試圖在每次關閉PPT時運行宏來處理圖片鏈接等一系列騷操作，可惜失敗了，不知道為什么事件寫進去但不生效 **）：APP_PresentationBeforeClose
3. 觸發方式二：代碼寫好，保存為ppam格式做成加載宏，單擊按鈕運行宏代碼。可惜遇到下面的問題：
   a. 無法查看加載宏，幸好找到一個適用我的電腦的注冊表鍵值設置方法：新建DebugAddins鍵值
   b.成功加載宏之后，沒有辦法像Excel一樣在“自定義快速訪問工具欄”增加按鈕觸發宏。花了幾個小時，終於找到守柔同學經年老貼：在菜單欄增加自定義按鈕以觸發運行加載宏
4. 另外，對自定義按鈕圖標FaceID感興趣的同學可以自行生成所有編號的圖標，以便選擇自己喜歡的樣式：遍歷並生成FaceID
5. PPT2013雙擊加載宏即可成功加載，如不成功，請自行百度設置一下宏安全級別和受信任位置

最后，終於通過加載宏的方式實現了一鍵實現更新圖片鏈接、另存到指定文件夾、斷開鏈接以避免彈窗提示等功能，加載宏代碼如下：

Option Explicit
Sub AddCommandBar() '加載時在常用工具欄中添加一個命令
Dim MyControl As CommandBarControl
On Error Resume Next
Application.CommandBars(“Standard”).Controls(“SaveWithoutLink”).Delete '預防性刪除
Set MyControl = Application.CommandBars(“Standard”).Controls.Add(Before:=1) '在常用工具欄最前面添加一個按鈕
With MyControl
.Caption = “SaveWithoutLink” '標題
.FaceId = 278 '圖標
.Enabled = True '可用
.Visible = True '顯示
.Width = 200 '寬度
.OnAction = “LinkUpdating” '運行指定的過程
.Style = msoButtonIconAndCaption '顯示的方式圖標+標題
End With
End Sub
Sub LinkUpdating()
Dim Pres As Presentation, Sl As Slide, Sh As Shape
Dim WeekN As Integer, Mon As String, MonthN As String, NameP As String
Set Pres = ActivePresentation

 
WeekN = DatePart(“WW”, Date) - 1
Mon = Format(Date - 30, “mmm”)
MonthN = Format(Date - 30, “mmmm”)
NameP = Pres.Name

For Each Sl In Pres.Slides
For Each Sh In Sl.Shapes
If Sh.Type = msoLinkedOLEObject Then
Application.DisplayAlerts = ppAlertsNone
Sh.LinkFormat.Update
End If
Next
Next
Pres.Save
If NameP Like “weekly” Then '不同文件命名方式和報告位置不同
Pres.SaveAs "S:\A01_Management_管理部\Weekly Report\2020\WK " & WeekN & “\IE weekly report on WK” & WeekN & “.pptx”
ElseIf NameP Like “KPI achievement” Then
Pres.SaveAs “S:\A01_Management_管理部\KPI monthly review of DAC in 2020” & MonthN & " 2020\KPI achievement review from Jan. to " & Mon & “. 2020 (IE).pptx”
Else
MsgBox “Please run macro in correct PPT file!”
Exit Sub
End If
For Each Sl In Pres.Slides
For Each Sh In Sl.Shapes
If Sh.Type = msoLinkedOLEObject Then
Application.DisplayAlerts = ppAlertsNone
Sh.LinkFormat.BreakLink
End If
Next
Next
Pres.Save
Pres.Close
Set Pres = Nothing
End Sub
Sub RemoveCommandBar()
On Error Resume Next
Application.CommandBars(“Standard”).Controls(“SaveWithoutLink”).Delete
End Sub

　　

加載后界面如下：
如有有懶漢子不想自己做加載宏，以下鏈接位置是成品：懶人專用