D
ddwmoq
I have several charts in a PowerPoint file linked with a hugh Excel
spreadsheet. I have written a VBA program to update the charts but it
does always not work. Sometimes I have to run it repeatedly to update
all the charts. Can anyone help?
Also, is there anyway to retrieve the source file name
programmatically?
Thanks.
------------------------------------------------------------------------------------------------------------------------------------
Sub Update_chart()
Dim sld As Slide, sh As Shape, oChart As Object, x As String
For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
If sh.Type = msoEmbeddedOLEObject Then
If sh.OLEFormat.ProgID = "MSGraph.Chart.8" Then
Set oChart = sh.OLEFormat.Object
With oChart
x = x + "Slide " + Str(sld.SlideNumber) + ": "
If .HasTitle Then
x = x + vbTab + .ChartTitle.Text
Else
x = x + vbTab + "[no title]"
End If
DoEvents
.Application.Update
DoEvents
.Application.Quit
End With
Set oChart = Nothing
End If
x = x + vbCr
End If
Next
Next
DoEvents
MsgBox "The following charts were updated: " + vbCr + x
End Sub
spreadsheet. I have written a VBA program to update the charts but it
does always not work. Sometimes I have to run it repeatedly to update
all the charts. Can anyone help?
Also, is there anyway to retrieve the source file name
programmatically?
Thanks.
------------------------------------------------------------------------------------------------------------------------------------
Sub Update_chart()
Dim sld As Slide, sh As Shape, oChart As Object, x As String
For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
If sh.Type = msoEmbeddedOLEObject Then
If sh.OLEFormat.ProgID = "MSGraph.Chart.8" Then
Set oChart = sh.OLEFormat.Object
With oChart
x = x + "Slide " + Str(sld.SlideNumber) + ": "
If .HasTitle Then
x = x + vbTab + .ChartTitle.Text
Else
x = x + vbTab + "[no title]"
End If
DoEvents
.Application.Update
DoEvents
.Application.Quit
End With
Set oChart = Nothing
End If
x = x + vbCr
End If
Next
Next
DoEvents
MsgBox "The following charts were updated: " + vbCr + x
End Sub