D
dan2bhm via AccessMonster.com
Hello all - I've got this VBA that runs perfectly when Executed in PowerPoint.
However, I can figure out how to execute it from Excel.
This is the code I have in PPT which works great:
Sub BreakLinks()
Dim oCmdButton As CommandBarButton
Set oCmdButton = CommandBars("Standard").Controls.Add(Id:=2956)
'ActiveWindow.ViewType = ppViewSlide
ActivePresentation.Slides(5).Select
ActivePresentation.Slides(4).Select
ActivePresentation.Slides(3).Select
ActivePresentation.Slides(2).Select
ActivePresentation.Slides(1).Select
For Each Slide In ActivePresentation.Slides
For Each Shape In Slide.Shapes
If Shape.Type = msoLinkedOLEObject Then
ActiveWindow.View.GotoSlide Slide.SlideIndex
Shape.Select
Application.CommandBars.FindControl(Id:=2956).Execute
' Do not forget to add this line else you will get erratic
' results since the code execution does not halt while menu
' command is executed hence we have to let the execution
' complete before proceeding.
DoEvents
End If
Next Shape
Next Slide
oCmdButton.Delete
ActivePresentation.Slides(5).Select
ActiveWindow.Selection.SlideRange.Shapes.Range(Array("Picture 317", "Picture
306", "Picture 320", "Picture 326")).Select
ActiveWindow.Selection.ShapeRange.Group.Select
ActivePresentation.Slides(1).Select
End Sub
This is what I have in Excel to try to accomplish the same task. The reason
I'm running it from Excel, is there's a LOT more VBA (which I'm not including)
that runs formulas, formatting...etc for the Excel Spreadsheets. I'd like to
be able to Break the links after the PPT Presentation is opened. The PPT
opens, and it simple doesn't execute the break links code. I'm not sure
where I've gone wrong.
Anybody know how to fix this???
Set ppt = CreateObject("powerpoint.application")
ppt.Visible = True
On Error Resume Next
ppt.UserControl = True
ppt.Presentations.Open Filename:= _
"S:\ARR\DRCC\Recurring Briefings\Database Products\Horseblanket\
HORSEBLANKET backup.ppt"
ppt.ActivePresentation.UpdateLinks
MsgBox "would you like to convert", vbOKOnly
Dim oShp As Shape
Dim oSld As Slide
Dim oCmdButton As CommandBarButton
Set oCmdButton = CommandBars("Standard").Controls.Add(ID:=2956)
'ActiveWindow.ViewType = ppViewSlide
ppt.ActivePresentation.Slides(5).Select
ppt.ActivePresentation.Slides(4).Select
ppt.ActivePresentation.Slides(3).Select
ppt.ActivePresentation.Slides(2).Select
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp .Type = msoLinkedOLEObject Then
ppt.ActiveWindow.View.GotoSlide oSld.SlideIndex
oShp.Select
ppt.Application.CommandBars.FindControl(ID:=2956).Execute
DoEvents
End If
Next oShp
Next oSld
oCmdButton.Delete
ppt.ActivePresentation.Slides(5).Select
ppt.ActiveWindow.Selection.SlideRange.Shapes.Range(Array("Picture 317",
"Picture 306", "Picture 320", "Picture 326")).Select
ppt.ActiveWindow.Selection.ShapeRange.Group.Select
ppt.ActivePresentation.Slides(1).Select
Thanks for the help!!
However, I can figure out how to execute it from Excel.
This is the code I have in PPT which works great:
Sub BreakLinks()
Dim oCmdButton As CommandBarButton
Set oCmdButton = CommandBars("Standard").Controls.Add(Id:=2956)
'ActiveWindow.ViewType = ppViewSlide
ActivePresentation.Slides(5).Select
ActivePresentation.Slides(4).Select
ActivePresentation.Slides(3).Select
ActivePresentation.Slides(2).Select
ActivePresentation.Slides(1).Select
For Each Slide In ActivePresentation.Slides
For Each Shape In Slide.Shapes
If Shape.Type = msoLinkedOLEObject Then
ActiveWindow.View.GotoSlide Slide.SlideIndex
Shape.Select
Application.CommandBars.FindControl(Id:=2956).Execute
' Do not forget to add this line else you will get erratic
' results since the code execution does not halt while menu
' command is executed hence we have to let the execution
' complete before proceeding.
DoEvents
End If
Next Shape
Next Slide
oCmdButton.Delete
ActivePresentation.Slides(5).Select
ActiveWindow.Selection.SlideRange.Shapes.Range(Array("Picture 317", "Picture
306", "Picture 320", "Picture 326")).Select
ActiveWindow.Selection.ShapeRange.Group.Select
ActivePresentation.Slides(1).Select
End Sub
This is what I have in Excel to try to accomplish the same task. The reason
I'm running it from Excel, is there's a LOT more VBA (which I'm not including)
that runs formulas, formatting...etc for the Excel Spreadsheets. I'd like to
be able to Break the links after the PPT Presentation is opened. The PPT
opens, and it simple doesn't execute the break links code. I'm not sure
where I've gone wrong.
Anybody know how to fix this???
Set ppt = CreateObject("powerpoint.application")
ppt.Visible = True
On Error Resume Next
ppt.UserControl = True
ppt.Presentations.Open Filename:= _
"S:\ARR\DRCC\Recurring Briefings\Database Products\Horseblanket\
HORSEBLANKET backup.ppt"
ppt.ActivePresentation.UpdateLinks
MsgBox "would you like to convert", vbOKOnly
Dim oShp As Shape
Dim oSld As Slide
Dim oCmdButton As CommandBarButton
Set oCmdButton = CommandBars("Standard").Controls.Add(ID:=2956)
'ActiveWindow.ViewType = ppViewSlide
ppt.ActivePresentation.Slides(5).Select
ppt.ActivePresentation.Slides(4).Select
ppt.ActivePresentation.Slides(3).Select
ppt.ActivePresentation.Slides(2).Select
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp .Type = msoLinkedOLEObject Then
ppt.ActiveWindow.View.GotoSlide oSld.SlideIndex
oShp.Select
ppt.Application.CommandBars.FindControl(ID:=2956).Execute
DoEvents
End If
Next oShp
Next oSld
oCmdButton.Delete
ppt.ActivePresentation.Slides(5).Select
ppt.ActiveWindow.Selection.SlideRange.Shapes.Range(Array("Picture 317",
"Picture 306", "Picture 320", "Picture 326")).Select
ppt.ActiveWindow.Selection.ShapeRange.Group.Select
ppt.ActivePresentation.Slides(1).Select
Thanks for the help!!