Updating Linked Power Point MsgBox

Mississippi Girl

Board Regular
Joined
Oct 27, 2005
Messages
155
I have a powerpoint deck with over 100 charts that are linked to Excel. I've turned off the auto-update and run a macro to update the links when desired. What I'd like to do is insert a message box after every 20th slide is updated as sort of a "status" update. This would be an information only box and wouldn't require the user to click OK to continue or anything. Is that even possible? I started down the path of a progress bar but that slowed the process down way too much. It already takes a good bit (3-4 minutes) to update all the links as it is. Here's the current VBA I'm using.

Code:
Sub Update_Links()
 Dim osld As Slide
 Dim oshp As Shape
 
 If MsgBox("Would you like to continue?", vbQuestion + vbYesNo) <> vbYes Then
 Exit Sub
 End If
 
 
 For Each osld In ActivePresentation.Slides
 For Each oshp In osld.Shapes
 If oshp.Type = msoLinkedOLEObject Then oshp.LinkFormat.Update
 Next oshp
 Next osld

 End Sub

Thanks for your help!
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
An alternate possibility is to create a button in the meny AddOn tab and then update the caption on the button with the desired data.

Code:
Sub CreateFeedbackButtonInAddOnsTab()

    Dim objCommandBar As CommandBar
    Dim objCommandBarEditBox As CommandBarComboBox
    Dim objCommandBarButton As CommandBarButton
    Dim objCommandBarControl As CommandBarControl
    
    Dim sCommandBarName As String
    Dim sCommandBarToolBarName As String
    
    sCommandBarName = "Feedback"
    sCommandBarToolBarName = "TB"

    'Delete Existing toolbars that you are about to recreate
    For Each objCommandBar In Application.CommandBars
        If objCommandBar.Name = sCommandBarName Then
            objCommandBar.Delete
        End If
    Next objCommandBar
    
    'Create Toolbar 1
    Set objCommandBar = Application.CommandBars.Add(sCommandBarName)
    objCommandBar.Name = sCommandBarName
    objCommandBar.Position = msoBarTop
    objCommandBar.Visible = True
    
    'Add to Toolbar 1 - Button 1
    Set objCommandBarButton = Application.CommandBars _
        (sCommandBarName).Controls.Add(Type:=msoControlButton)
    objCommandBarButton.Caption = "Data Here"
    objCommandBarButton.OnAction = "Button1"
    objCommandBarButton.Style = msoButtonWrapCaption

End Sub

Private Sub UpdateFeedbackButtonGuts(sNewValue As String)

    Dim objCommandBar As CommandBar
    Dim objCommandBarEditBox As CommandBarComboBox
    Dim objCommandBarButton As CommandBarButton
    Dim objCommandBarControl As CommandBarControl
    
    Dim sCommandBarName As String
    Dim sCommandBarToolBarName As String
    
    sCommandBarName = "Feedback"
    sCommandBarToolBarName = "TB"

    Application.CommandBars(sCommandBarName).Controls(1).Caption = sNewValue

End Sub

Sub UpdateFeedbackButton()
    UpdateFeedbackButtonGuts "This is new info"
End Sub
 
Upvote 0
Thanks Phil!
I ended up creating a form that just stays open while the macro runs.
When the slides are updated, the form closes and a message box pops up saying the task is complete.
 
Upvote 0
Please post the code you ended up using to help others that may require a similar solution.
 
Upvote 0
First, I used this from Shyam Pillai to turn off the automatic update on start up (there is an option within to turn the auto-update back on):

Code:
Option Explicit

' --------------------------------------------------------------------------------
' Copyright ©1999-2014, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

 

Sub UpdateMode()
    Dim lCtrA As Integer
    Dim oPres As Object 'Presentation
    Dim oSld As Slide
    Set oPres = ActivePresentation
    With oPres
        ' Process shapes on the slides
        For Each oSld In .Slides
            Call SetLinksToManual(oSld)
        Next
        ' Process shapes on the slides masters
        If Val(Application.Version) > 9 Then
            'For versions 2002 and later with multiple master support
            For lCtrA = 1 To .Designs.Count
                If .Designs(lCtrA).HasTitleMaster Then
                    Call SetLinksToManual(.Designs(lCtrA).TitleMaster)
                Else
                    Call SetLinksToManual(.Designs(lCtrA).SlideMaster)
                End If
            Next
        Else
            ' Version 97/2000
            Call SetLinksToManual(.SlideMaster)
            If .HasTitleMaster Then
                Call SetLinksToManual(.TitleMaster)
            End If
        End If
    End With

End Sub
Sub SetLinksToManual(oSlideOrMaster As Object)
    Dim oShp As PowerPoint.Shape
    For Each oShp In oSlideOrMaster.Shapes
        If oShp.Type = msoLinkedOLEObject Then
        'Set the link to manual update mode
           oShp.LinkFormat.AutoUpdate = ppUpdateOptionManual
        End If
    Next oShp
End Sub
Sub SetLinksToAutomatic(oSlideOrMaster As Object)
    Dim oShp As PowerPoint.Shape
    For Each oShp In oSlideOrMaster.Shapes
        If oShp.Type = msoLinkedOLEObject Then
        'Set the link to automatic update mode
           oShp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
        End If
    Next oShp
End Sub

Then this to make the updates when needed:
Code:
Option Explicit

Sub Update_Links()
 Dim oSld As Slide
 Dim oShp As Shape
 
 If MsgBox("Would you like to continue?", vbQuestion + vbYesNo, "This could take while...") <> vbYes Then
 Exit Sub
 End If
 
 Userform1.Show False

 For Each oSld In ActivePresentation.Slides
 For Each oShp In oSld.Shapes
 If oShp.Type = msoLinkedOLEObject Then oShp.LinkFormat.Update
 Next oShp
 Next oSld

 Userform1.Hide

 MsgBox "Links have been updated"
 
 End Sub
 
Upvote 0

Forum statistics

Threads
1,214,528
Messages
6,120,065
Members
448,942
Latest member
sharmarick

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top