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双击加载宏即可成功加载，如不成功，请自行百度设置一下宏安全级别和受信任位置

最后，终于通过加载宏的方式实现了一键实现更新图片链接、另存到指定文件夹、断开链接以避免弹窗提示等功能，加载宏代码如下：

?

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 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60

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

　　

加载后界面如下：
如有有懒汉子不想自己做加载宏，以下链接位置是成品：懒人专用