Sub CaptionPPT()
Dim pptapp As Object
Dim pptpres As Object
Dim lngCount As Long
Dim SW As Long
Const ppAlignCenter = 2
Set pptapp = CreateObject(Class:="PowerPoint.Application")
pptapp.Visible = True
'change the address as required
Set pptpres = pptapp.Presentations.Open("C:\Users\John\Desktop\test.pptx")
For lngCount = 2 To pptpres.slides.Count
With pptpres.slides(lngCount).Shapes.AddTextbox(msoTextOrientationHorizontal, _
pptpres.PageSetup.SlideWidth / 2 - 100, pptpres.PageSetup.SlideHeight - 50, 200, 15)
.TextFrame.TextRange.Text = ActiveSheet.Range("A1").Offset(lngCount - 1, 0)
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
End With
Next
End Sub