Sub AddSlidetime()

Slidetime

End Sub
Function Slidetime()

   Dim curSlide As Slide
   Dim curShape As Shape
   Dim ShapeText As String
   
    For Each curSlide In ActivePresentation.Slides
            
        ShapeText = Format(curSlide.SlideNumber, "000") & " | " & curSlide.SlideShowTransition.AdvanceTime
        
        Set curShape = ShapeNamed("TextBoxSeek", curSlide)
        
        If Not curShape Is Nothing Then
            curShape.TextFrame.TextRange.Text = ShapeText
        Else
            With curSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 383, 62, 22)
             .TextFrame.TextRange.Font.Size = 12
             .TextFrame.TextRange.Font.Bold = True
             .TextFrame.TextRange.Font.Color.RGB = RGB(255, 0, 0)
             .TextFrame.TextRange.Text = ShapeText
             .Name = "TextBoxSeek"
            End With
        End If

    Next curSlide

End Function
Function ShapeNamed(sShapeName As String, oSl As Slide) As Shape

  Dim oSh As Shape

  For Each oSh In oSl.Shapes
     If oSh.Name = sShapeName Then
        Set ShapeNamed = oSh
        Exit Function
     End If
  Next

End Function
Sub DelSlidetime()

SlidetimeDelite

End Sub
Function SlidetimeDelite()

   Dim curSlide As Slide
   Dim curShape As Shape
   
    For Each curSlide In ActivePresentation.Slides
        
        Set curShape = ShapeNamed("TextBoxSeek", curSlide)
        
        If Not curShape Is Nothing Then curShape.Delete

    Next curSlide

End Function