こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

パワーポイント2013 ファイル名自動表示方法

パワーポイントの全スライドのフッタの左に印刷日時、中央に頁番号/全ページ数、右下にファイル名を指定のフォントとサイズ(ポイント)で自動挿入する方法(VBAコード)をご教示下さい 。フッタの位置を手動で変更できれば嬉しい。

投稿日時 - 2018-09-07 17:36:05

QNo.9534936

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

パワーポイントでVBAを扱ったことがないので
勉強を兼ねて挑戦してみました。

>印刷日時
印刷をするマクロではないので、マクロの実行日時としました。

>フッタの位置を手動で変更できれば
この求めがよくわかりません。
そもそもパワーポイントですので、移動は自由です。

パワーポイントが用意しているフッターを使うと
いろいろ厄介なので
自前でテキストボックスを追加する仕様としました。

また、
追加と諸々の設定(編集)を1つのプロシージャで行うと
編集が期待通りになっていない場合
追加したテキストボックスを削除する必要があるので、
追加と編集を別にしました。

つまり、追加は1回だけ行い、
編集は何度でもやり直せる仕様としました。

'//------------------------------------------------------------------------------------------------
'// オリジナルフッター作成
'//------------------------------------------------------------------------------------------------
Sub MakeMyFooter()
 Dim SlideCount As Long '総スライド数
 Dim SlideCounter As Long 'Slideカウンター
 Dim txt As Shape
 Const FootFontSize = 20
 Const FootTop = 500
 Const Foot1Height = 30
 Const Foot1Width = 250
 Const Foot1Left = 10
 Const Foot2Height = 30
 Const Foot2Width = 60
 Const Foot2Left = 310
 Const Foot3Height = 30
 Const Foot3Width = 300
 Const Foot3Left = 510
 
 '総スライド数算出
 SlideCount = ActivePresentation.Slides.Count
 
 'Footer1,2,3を追加
 With ActivePresentation
  For SlideCounter = 1 To SlideCount

   Set txt = .Slides(SlideCounter).Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=Foot1Left, _
    Top:=FootTop, _
    Width:=Foot1Width, _
    Height:=Foot1Height)

   With txt
    .Name = "Foot1"
    .TextFrame.TextRange = "Foot1"
    .TextEffect.FontSize = FootFontSize
   End With

   Set txt = .Slides(SlideCounter).Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=Foot2Left, _
    Top:=FootTop, _
    Width:=Foot2Width, _
    Height:=Foot2Height)

   With txt
    .Name = "Foot2"
    .TextFrame.TextRange = "Foot2"
    .TextEffect.FontSize = FootFontSize
   End With

   Set txt = .Slides(SlideCounter).Shapes.AddTextbox( _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=Foot3Left, _
    Top:=FootTop, _
    Width:=Foot3Width, _
    Height:=Foot3Height)

   With txt
    .Name = "Foot3"
    .TextFrame.TextRange = "Foot3"
    .TextEffect.FontSize = FootFontSize
   End With

  Next SlideCounter
 End With

End Sub


'//------------------------------------------------------------------------------------------------
'// オリジナルフッター編集
'//------------------------------------------------------------------------------------------------
Sub ChangeMyFooter()
 Dim SlideCount As Long '総スライド数
 Dim SlideCounter As Long 'Slideカウンター
 Dim txt As Shape
 
 'Const FootFont = "HGP創英角ポップ体"
 Const FootFont = "MS 明朝"
 Const FootFontSize = 12
 Const FootTop = 450
 Const Foot1Height = 30
 Const Foot1Width = 250
 Const Foot1Left = 10
 Const Foot2Height = 30
 Const Foot2Width = 60
 Const Foot2Left = 310
 Const Foot3Height = 30
 Const Foot3Width = 300
 Const Foot3Left = 510
 
 '総スライド数算出
 SlideCount = ActivePresentation.Slides.Count
 
 'Footer1,2,3を編集
 With ActivePresentation
  For SlideCounter = 1 To SlideCount
   With .Slides(SlideCounter).Shapes("Foot1")
    .Height = Foot1Height
    .Width = Foot1Width
    .Left = Foot1Left
    .Top = FootTop
    .TextFrame.TextRange.Text = Format(Now, "YYYY/MM/DD HH:MM")
    .TextEffect.FontSize = FootFontSize
    .TextEffect.FontName = FootFont
   End With
   
   With .Slides(SlideCounter).Shapes("Foot2")
    .Height = Foot2Height
    .Width = Foot2Width
    .Left = Foot2Left
    .Top = FootTop
    .TextFrame.TextRange.Text = Format(SlideCounter, "0") & "/" & Format(SlideCount, "0")
    .TextEffect.FontSize = FootFontSize
    .TextEffect.FontName = FootFont
   End With
   
   With .Slides(SlideCounter).Shapes("Foot3")
    .Height = Foot3Height
    .Width = Foot3Width
    .Left = Foot3Left
    .Top = FootTop
    .TextFrame.TextRange.Text = ActivePresentation.Name
    .TextEffect.FontSize = FootFontSize
    .TextEffect.FontName = FootFont
   End With
  Next SlideCounter
 End With

End Sub

投稿日時 - 2018-09-12 21:14:41

お礼

ありがとうございます。試してみます。

投稿日時 - 2018-09-16 17:29:49