PPTXファイルを一括でPPSXファイルに変換

PPTXファイルを一括でPPSXファイルに変換するスクリプトのメモ。

イベントの運営してると、みんな直前まで資料を修正してて、

直前に一気にスライショー形式に変換しないといけなくなることも。

PPTのときは拡張子だけPPSにすればよかったから楽だったけど。。

PPTXになってからは拡張子だけ変えても。。。

そこでPPTXを一括でPPSXに変換できるVBSスクリプト。

PowerPoint入ってないと動かない。

対象ファイルをVBSスクリプトファイルにドロップ。

複数ファイルのドロップも可。

進捗をIEを使って表示する。

ファイル名は任意。

■VBSスクリプトファイル

Option Explicit
Call Main()

Sub Main()
  Const S2T = 24
  Const T2S = 28
  Dim myFname, myOffice, myArgNum, i, myIE

  myArgNum = Wscript.Arguments.Count

  If myArgNum = 0 Then
    Wscript.Echo "変換したいファイルを本スクリプトにドロップしてください。"
    Exit Sub
  End If

  '進捗表示用のIEオブジェクトを生成
  Set myIE = WScript.CreateObject("InternetExplorer.Application")
  myIE.Navigate "about:blank"
  While myIE.busy: Wend
  While myIE.Document.readyState <> "complete": DoEvents : Wend
  myIE.AddressBar = False
  myIE.ToolBar = False
  myIE.StatusBar = False
  myIE.Height = 150
  myIE.Width = 500
  myIE.Visible = True

  i = 1
  For Each myFname In Wscript.Arguments
    Set myOffice = GetObject(myFname)
    myIE.Document.body.innerHTML = "【進捗】" & i & " / " & myArgNum & "

【処理ファイル】" & myOffice.Name & ""
    If myOffice.Application = "Microsoft PowerPoint" Then
      '末尾の「T2S」を「S2T」にするとPPSX→PPTX
      myOffice.SaveAs GetFNameFromFStr(myOffice.FullName)+".ppsx", T2S
    End If
    myOffice.Close
    i = i + 1
  Next
  myIE.Quit
  Wscript.Echo "完了"
End Sub

Function GetFNameFromFStr(sFileName )
Dim sFileStr' As String
Dim lFindPoint 'As Long
Dim lStrLen' As Long
    lFindPoint = InStrRev(sFileName, ".")
    sFileStr = Left(sFileName, lFindPoint - 1)
    GetFNameFromFStr = sFileStr
End Function