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

  • Article

全然話が変わるのですが、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

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