I'm close, but it is only updating one shape per slide. Often times I will have multiple shapes with the same tag.
How can I cycle through all the shapes on each slide?
![]()
Sub addID() Dim oSld As Slide Dim oShp As Shape Dim i As Integer 'Call deleteID 'For Each oSld In ActivePresentation.Slides 'for all slides Set oSld = ActiveWindow.View.Slide 'for only the active slide Set oShp = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 100, 20) With oShp '.TextFrame.TextRange = CStr(osld.SlideID) 'adds slide ID number .TextFrame.TextRange = CStr(oSld.SlideID & "/" & oSld.SlideIndex) 'adds slide ID and Index number '.TextFrame.TextRange = CStr("Seq. " & osld.SlideIndex & "0") 'adds slide index number .Tags.Add "ID", CStr(oSld.SlideID) End With 'Next oSld End Sub Sub deleteID() Dim oSld As Slide Dim slideSTR As String Dim i As Integer For Each oSld In ActivePresentation.Slides 'for all slides slideSTR = oSld.SlideID For i = oSld.Shapes.Count To 1 Step -1 If oSld.Shapes(i).Tags("ID") = slideSTR Then oSld.Shapes(i).Delete Next i Next oSld End Sub Sub updateID() Dim oSld As Slide Dim oShp As Shape Dim oTemp As Shape Dim sTagValue As String On Error GoTo ErrorHandler For Each oSld In ActivePresentation.Slides 'for all slides sTagValue = oSld.SlideID For Each oShp In oSld.Shapes 'look at each shape on the slide 'see if the tag has value we're after If oShp.Tags("ID") = sTagValue Then 'this is the shape we're after oShp.TextFrame.TextRange = CStr(oSld.SlideID & "/" & oSld.SlideIndex) Exit For End If Next Next oSld NormalExit: Exit Sub ErrorHandler: MsgBox "Error: " & Err.Number & " " & Err.Description Resume NormalExit End Sub











LinkBack URL
About LinkBacks
Register To Reply
Bookmarks