Add-in to automatically insert caption to a picture?

[New Daddy]

Too bad PowerPoint does not provide a native function to automatically add caption to a picture as Word does.

Does anybody know of a third-party add-in that does this?

[Rudi]

If you choose to create a Photo Album, PPT does create auto captions that resemble the picture file name...
I'm guessing though that you are looking for auto captions on standard presentations for pictures?

Captions.jpg

A macro can do this ~ as in; loop through all slides and add a small text box below any image on the slide? For a macro like this it might be best to visit the PPT MVP's on the Microsoft Forum; unless Hans can conjure up something special?

[HansV]

Another option would be to create a new layout in Slide Master View consisting of a picture placeholder and a caption placeholder (plus whatever else you want, of course). For example:

S0480.png

You could of course create a layout for two pictures with captions etc.

[Rudi]

Here is some code that I pirated from various areas and combined together to create a caption...
I dunno how to loop it through all slides though...Currently you must run it on a slide.

Code: Select all

Sub Create_A_Caption()
Dim Sld As Slide
Dim Shp As Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

    ' Determine height and width of slide.
    With ActivePresentation.PageSetup
        lngSlideHeight = .SlideHeight
        lngSlideWidth = .SlideWidth
    End With

    'ERROR HANDLING
    If ActivePresentation.Slides.Count = 0 Then
        MsgBox "You do not have any slides in your PowerPoint project."
        Exit Sub
    End If

    Set Sld = Application.ActiveWindow.View.Slide

    'Create shape with Specified Dimensions and Slide Position
    Set Shp = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
                                  Left:=24, Top:=65.6, Width:=672, Height:=26.6)

    With Shp
        With .TextFrame.TextRange
            .Text = "Caption text here..."
            With .ParagraphFormat
                .Alignment = ppAlignCenter
                .Bullet = msoFalse
            End With
            With .Font
                .Bold = msoTrue
                .Name = "Tahoma"
                .Size = 14
            End With
        End With
        
        'No Shape Border
        .Line.Visible = msoFalse
        'Shape Fill Color
        .Fill.ForeColor.RGB = RGB(184, 59, 29)
        'Shape Text Color
        .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
        ' Shrink the Textbox to match the text it now contains.
        .Width = .TextFrame.TextRange.BoundWidth + 100
        .Height = .TextFrame.TextRange.BoundHeight + 10
        .Left = (lngSlideWidth - .Width) / 2
        .Top = (lngSlideHeight - .Height) / 1.05
    End With
    
End Sub