How To Insert Headers And Footers In All Slides Of Powerpoint Via Access Vba (1 Viewer)

R

Rakesh935

Registered User.
Local time
Today, 19:44
Joined
Oct 14, 2012
Messages
71
Hi,

I wrote a code to update header and footers for all the slides of a particular powerpoint file (I have huge number of power point files having various slides to update) but seems I have gone somewhere wrong because of which its not happening. Requesting if anybody can help me. Below is the 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

FooterText = .ActivePresentation.FullName
.ActivePresentation.Slides.Range.HeadersFooters.Foo ter.Visible = True
.ActivePresentation.Slides.Range.HeadersFooters.Foo ter.Text = "ABC"

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
 
Rx_

Rx_

Nothing In Moderation
Local time
Today, 08:14
Joined
Oct 22, 2009
Messages
2,803
Got this to work. It is past lunch time so I still fell there is some unrequired code. Perhaps you can take out what is not needed and re-post it for others?
Needles to say - this requires going to Tools - References and setting a checkbox to Microsoft PowerPoint 14 Object Library


Code: 
Sub PowerPointHeader()
      Dim PowerPoint As PowerPoint.Application
      Dim FooterText As String
      Dim ppt As PowerPoint.Presentation
      Dim PowerPointSelection As PowerPoint.Selection
      Dim strpptPath As String
      Dim fDialog As FileDialog
      ' Set up the File Dialog. '
10    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
      Dim varFile As Variant
20    With fDialog
30    .AllowMultiSelect = True
40    .Title = "Select File Location to Export pptx :"
50    .InitialFileName = ""
60    If .Show = True Then
70    For Each varFile In .SelectedItems
80    GetFileName = varFile
90    strpptPath = GetFileName
100   Set PowerPoint = CreateObject("PowerPoint.Application")
110   PowerPoint.Visible = True
120   PowerPoint.Presentations.Open (strpptPath)
      'With PowerPoint
130   FooterText = PowerPoint.ActivePresentation.FullName
140   PowerPoint.ActivePresentation.Slides.Range.HeadersFooters.Footer.Visible = True
150   PowerPoint.ActivePresentation.Slides.Range.HeadersFooters.Footer.Text = "ABC"
      'End With
160   PowerPoint.ActivePresentation.Save
170   PowerPoint.ActivePresentation.Close
180   PowerPoint.Quit
190   Set ppt = Nothing
200   Set PowerPoint = Nothing
210   Set PowerPointSelection = Nothing
220   Next
230   End If
240   End With
250   Set ppt = Nothing
260   Set ppt = Nothing
270   MsgBox "Updated Successfully"
      ' .SaveAs FileName:=sTempPath & "PPTSample1.pptx", FileFormat:=ppSaveAsDefault  ' just in case.
End Sub
If this tip was helpful a click on the scales would be appreciated (e.g. tip the scales)
 
R

Rakesh935

Registered User.
Local time
Today, 19:44
Joined
Oct 14, 2012
Messages
71
Thank you very much for the reply and it is already past mid night here.....

However, I finally made the code corrected and good to be executed....below mentioned the corrected 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 once again....
Rakesh
 
You must log in or register to reply here.

Similar threads

W
CSV or XLSX Bank Statement to Access module (need to import via VBA and then write back to Excel with imported flag)
Replies
14
Views
1,049
Cotswold
Cotswold
The Rev
Solved Using Access VBA to change a Powerpoint text box value
2
Replies
20
Views
3,192
Minty
Minty
mdnuts
  • Locked
Access VBA - insert table into word header
Replies
2
Views
7,744
mdnuts
mdnuts
R
Inserting Text box in PowerPoint slides from access vba
Replies
1
Views
5,539
JHB
J
M
insert picture in SQL with VBA
Replies
3
Views
1,402
JHB
J

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom