Inserting Text box in PowerPoint slides from access vba (1 Viewer)

[Rakesh935]

Hi,

I have written a code to insert footers in all the slides of a PowerPoint presentation which is apparently working fine. But, now the requirement has got changed and instead of footers the code should create a text box with some text in all the slides of a PowerPoint presentation.

Requesting anybody to help me in the text box creation code added up with the below mentioned code.

Dim PowerPoint As PowerPoint.Application
Dim ppt As PowerPoint.Presentation
Dim PowerPointSelection As PowerPoint.Selection
Dim strpptPath As String
Dim fDialog As FileDialog

' Set up the File Dialog. '
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Dim varFile As Variant
With fDialog
.AllowMultiSelect = True
.Title = "Select File Location to Export pptx :"

.InitialFileName = ""
If .Show = True Then
For Each varFile In .SelectedItems
GetFileName = varFile
strpptPath = GetFileName
Set PowerPoint = CreateObject("PowerPoint.Application")
PowerPoint.Visible = True
PowerPoint.Presentations.Open (strpptPath)
With PowerPoint
For i1 = 1 To .ActivePresentation.Slides.Count
FooterText = .ActivePresentation.FullName
.ActivePresentation.Slides.Range(i1).HeadersFooters.Footer.Visible = True
.ActivePresentation.Slides.Range(i1).HeadersFooters.Footer.Text = "ABC"
Next i1

End With

PowerPoint.ActivePresentation.Save
PowerPoint.ActivePresentation.Close
PowerPoint.Quit
Set PowerPoint = Nothing
Set ppt = Nothing
Set PowerPointSelection = Nothing

Next
End If
End With
Set PowerPoint = Nothing
Set ppt = Nothing
MsgBox "Updated Successfully"


Thank you,
Rakesh

 

[JHB]

[FONT=&quot]Insert the following line to you code, it will create a text box.[/FONT]
....
For i1 = 1 To .ActivePresentation.Slides.Count
.ActivePresentation.Slides.Range(i1).Shapes.AddTextbox(msoTextOrientationHorizontal, left:=100, top:=100, Width:=200, Height:=50).TextFrame.TextRange.Text = "Test Box"

....