スクリプトを使用して PPT から アニメーションを一括削除


全然話が変わるのですが、slideshare(スライドシェア)ってご存知ですか?

Junichi Anno Presentations

PPT や PDF なんかをインターネット上で共有するのに、とても便利なサイトです。私も、セミナー資料で外部に公開できるものは、このサイトで公開しています。

ただ、ちょっと困ったことがあります。

それは、PowerPoint 2010 で作成したプレゼンテーションがうまくアップロードできないことがあります。

image

私の経験上、うまくいかない条件は以下の通りです。

  • アニメーションがついている
  • フォントが埋め込んである
    image

じゃぁ…ということでアニメーションを片っ端から削除すればよいのですが、例えば300ページもある資料のアニメーションをちまちま削除するのは超面倒くさい!

ということで、スクリプトで一気に処理することにします。

今回は、ものぐさして VBScript を使いました。拡張子、.vbs で保存してください。

On Error Resume Next

‘ファイル名をフルパスで指定
PPTFileName = "c:\tmp\ADFS2_ACSV2_Azure_StepByStep_v2.2_Update1_NoAnime.pptx"

ppSaveAsPresentation     = 1
ppSaveAsPowerPoint7      = 2
ppSaveAsPowerPoint4    = 3
ppSaveAsPowerPoint3    = 4
ppSaveAsTemplate    = 5
ppSaveAsRTF        = 6
ppSaveAsShow        = 7
ppSaveAsAddIn        = 8
ppSaveAsPowerPoint4FarEast    = 10
ppSaveAsDefault        = 11
ppSaveAsHTML        = 12
ppSaveAsHTMLv3        = 13
ppSaveAsHTMLDual    = 14
ppSaveAsMetaFile    = 15
ppSaveAsGIF        = 16
ppSaveAsJPG        = 17
ppSaveAsPNG        = 18
ppSaveAsBMP        = 19
msoFalse = 0
msoTrue = -1
msoTriStateMixed = -2

‘PowerPoint起動
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True

‘ファイルオープン
Set objPresentation = objPPT.Presentations.Open(PPTFileName)

Wscript.Echo "ファイル名:" & pptFileName
Wscript.Echo "スライド数:" & objPresentation.Slides.Count

flgDeleted = False

‘スライドを1枚1枚確認
For I = 1 To objPresentation.Slides.Count

   strTitle = objPresentation.Slides(i).Shapes(1).TextFrame.TextRange.Text
   strSlideNumber = objPresentation.Slides(i).SlideNumber
   strNumOfAnimationItems = objPresentation.Slides(i).TimeLine.MainSequence.Count

   ‘もしアニメーションが含まれていれば全部削除 
   If objPresentation.Slides(i).TimeLine.MainSequence.Count <> 0 Then
    flgDeleted = True
    Wscript.Echo strSlideNumber & ":" & strTitle
    WScript.Echo "   " & strNumOfAnimationItems & " 個のアニメーションを削除します"
    For j = objPresentation.Slides(i).TimeLine.MainSequence.Count To 1 Step -1
        objPresentation.Slides(i).TimeLine.MainSequence(j).Delete
    Next
   End If

Next

If flgDeleted = True Then
    ‘名前を付けて保存。このとき、フォントの埋め込みは解除(msoFalse)
    objPresentation.SaveCopyAs PPTFileName & ".アニメ削除済.pptx",ppSaveAsDefault,msoFalse
Else
    WScript.Echo "アニメーションは存在しませんでした"
End If

objPresentation.Close
objPPT.quit

Wscript.Quit

かなり手抜きのスクリプトですが、参考までに。

Comments (0)

Skip to main content