Updating PowerPoint Text Boxes Using VBA Input Box

[celebrationnm]

Hello,

Looking to do something pretty simple here but a few hours of Googling isn't getting me anywhere.

Would like to create a macro where:

1. User runs maco
2. Input Box opens where user inputs free text
3. Free text overwrites whatever text is currently in a particular text box on the "parent" Side Master. This is not a placeholder but a true text box.

I am comfortable with naming text boxes, etc.

Thank you!
Nick

 

[minimaster]

Hi celbrationnm,
do you like to have the VBA code inside a ppt file or ppa addin or inside an excel file or xla addin?

 

[minimaster]

A short example how to work with Powerpoint textboxes.

Sub add_Remarks_to_all_slides()
    ' this routine will add a little textbox to each slide with time and date
    Call add_Textbox_to_All_Slides(Format(Date, "dd.mmm.yyyy") & "  10:15am")
End Sub

Private Sub add_Textbox_to_All_Slides(remark As String)
    Dim PPApp As Object 'PowerPoint.Application
    Dim PPPres As Object 'PowerPoint.Presentation
    Set PPApp = getPP()
    Set PPPres = getPresentation(PPApp)
    Dim pSlide As Object 'PowerPoint.Slide
    Dim pShape As Object ' PowerPoint.Shape
    For Each pSlide In PPPres.Slides
        Set pShape = pSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                              Left:=PPPres.PageSetup.SlideWidth - 500, _
                                              Top:=2, _
                                              Width:=500, _
                                              Height:=25)
        With pShape.TextFrame
            .WordWrap = msoTrue
            .TextRange.Text = remark
            .TextRange.Font.Size = 12
        End With
        With pShape
            .Width = .TextFrame.TextRange.BoundWidth + 10
            .Height = .TextFrame.TextRange.BoundHeight
        End With
        pShape.Left = PPPres.PageSetup.SlideWidth - pShape.Width - 3
    Next pSlide
End Sub

Private Function getPP() As Object 
' Purpose: to get a handle on the active PowerPoint application
' will start Powerpoint if it isn't running yet
    On Error Resume Next
    Set getPP = GetObject(, "Powerpoint.Application")
    If Err.Number <> 0 Then  ' iff PP isn't  there lets  start it
        Set getPP = CreateObject("Powerpoint.Application")
        Err.Clear
        getPP.Visible = msoCTrue
    End If
    '    getPP.Visible = msoCTrue
End Function

Private Function getPresentation(PPApp As Object) As Object 
   ' Purpose: to get the active presentation
    On Error Resume Next
    Set getPresentation = PPApp.ActivePresentation
    If Err.Number <> 0 Then         'if no presentation lets create one
        Set getPresentation = PPApp.Presentations.Add(True)
        Err.Clear
    End If
End Function