PPT加载宏运⾏教程——实现更新图⽚链接、另存、断开链接等
功能
最近因为懒得⼿⼯⼀个个更新PPT图表，所以设置了从Excel复制粘贴图⽚链接到PPT的骚操作：
在Excel做好图表→复制图⽚→在PPT⾥“选择性粘贴”→可以实现在打开PPT（批量更新）或者单击链接图⽚（单个更新）时跟Excel同步更新内容：
但是，对的，碰上了凡事都有的但是！这个骚操作留下了每次打开PPT都问“要不要更新链接”的⽑病：
领导不满意啊：⼩伙⼦，Macro来⼀下，搞定这个问题！
于是花了时间到以下关键资料：
1. 更新图⽚链接的语句：
2. 触发⽅式⼀：在关闭PPT前运⾏程序的事件（试图在每次关闭PPT时运⾏宏来处理图⽚链接等⼀系列骚操作，可惜失败了，不知道为
什么事件写进去但不⽣效 **）：
3. 触发⽅式⼆：代码写好，保存为ppam格式做成加载宏，单击按钮运⾏宏代码。可惜遇到下⾯的问题：
a. ⽆法查看加载宏，幸好到⼀个适⽤我的电脑的注册表键值设置⽅法：
b.成功加载宏之后，没有办法像Excel⼀样在“⾃定义快速访问⼯具栏”增加按钮触发宏。花了⼏个⼩时，终于到守柔同学经年⽼贴：
4. 另外，对⾃定义按钮图标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
加载后界⾯如下：
如有有懒汉⼦不想⾃⼰做加载宏，以下链接位置是成品：

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。