ExcelとPowerPointをPDFに変換するのに似たVBScript

Question

ExcelとPowerPointのドキュメントをPDFに完全に変換する方法を探しています。私はWord用のこのスクリプトを使用しており、それは完璧に動作しますhttps://gallery.technet.microsoft.com/office/Script-to-convert-Word-08c5154b。私はExcelとPowerPointのための同様のスクリプトを探していて、インターネット上でそれを見つけることができません。私はVBでの経験はあまりありません。だからどこのオフィスアプリケーションを使うのか分かりません。 ExcelとPowerPoint、または他のパッケージで動作するようにスクリプトを変更できるVBに習熟している人に提供できる人はいますか？私は、PDFオプションとして保存されたプログラムが同じであるという意図を変更すると仮定していますか？

Wordのスクリプトは、同様に以下の通りです：

Option Explicit 
'################################################ 
'This script is to convert Word documents to PDF files 
'################################################ 
Sub main() 
Dim ArgCount 
ArgCount = WScript.Arguments.Count 
Select Case ArgCount 
    Case 1 
     MsgBox "Please ensure Word documents are saved,if that press 'OK' to continue",,"Warning" 
     Dim DocPaths,objshell 
     DocPaths = WScript.Arguments(0) 
     StopWordApp 
     Set objshell = CreateObject("scripting.filesystemobject") 
     If objshell.FolderExists(DocPaths) Then 'Check if the object is a folder 
      Dim flag,FileNumber 
      flag = 0 
      FileNumber = 0 
      Dim Folder,DocFiles,DocFile  
      Set Folder = objshell.GetFolder(DocPaths) 
      Set DocFiles = Folder.Files 
      For Each DocFile In DocFiles 'loop the files in the folder 
       FileNumber=FileNumber+1 
       DocPath = DocFile.Path 
       If GetWordFile(DocPath) Then 'if the file is Word document, then convert it 
        ConvertWordToPDF DocPath 
        flag=flag+1 
       End If 
      Next 
      WScript.Echo "Totally " & FileNumber & " files in the folder and convert " & flag & " Word Documents to PDF fles." 

     Else 
      If GetWordFile(DocPaths) Then 'if the object is a file,then check if the file is a Word document.if that, convert it 
       Dim DocPath 
       DocPath = DocPaths 
       ConvertWordToPDF DocPath 
      Else 
       WScript.Echo "Please drag a word document or a folder with word documents." 
      End If 
     End If 

    Case Else 
     WScript.Echo "Please drag a word document or a folder with word documents." 
End Select 
End Sub 

Function ConvertWordToPDF(DocPath) 'This function is to convert a word document to pdf file 
    Dim objshell,ParentFolder,BaseName,wordapp,doc,PDFPath 
    Set objshell= CreateObject("scripting.filesystemobject") 
    ParentFolder = objshell.GetParentFolderName(DocPath) 'Get the current folder path 
    BaseName = objshell.GetBaseName(DocPath) 'Get the document name 
    PDFPath = parentFolder & "\" & BaseName & ".pdf" 
    Set wordapp = CreateObject("Word.application") 
    Set doc = wordapp.documents.open(DocPath) 
    doc.saveas PDFPath,17 
    doc.close 
    wordapp.quit 
    Set objshell = Nothing 
End Function 

Function GetWordFile(DocPath) 'This function is to check if the file is a Word document 
    Dim objshell 
    Set objshell= CreateObject("scripting.filesystemobject") 
    Dim Arrs ,Arr 
    Arrs = Array("doc","docx") 
    Dim blnIsDocFile,FileExtension 
    blnIsDocFile= False 
    FileExtension = objshell.GetExtensionName(DocPath) 'Get the file extension 
    For Each Arr In Arrs 
     If InStr(UCase(FileExtension),UCase(Arr)) <> 0 Then 
      blnIsDocFile= True 
      Exit For 
     End If 
    Next 
    GetWordFile = blnIsDocFile 
    Set objshell = Nothing 
End Function 

Function StopWordApp 'This function is to stop the Word application 
    Dim strComputer,objWMIService,colProcessList,objProcess 
    strComputer = "." 
    Set objWMIService = GetObject("winmgmts:" _ 
     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
    'Get the WinWord.exe 
    Set colProcessList = objWMIService.ExecQuery _ 
     ("SELECT * FROM Win32_Process WHERE Name = 'Winword.exe'") 
    For Each objProcess in colProcessList 
     'Stop it 
     objProcess.Terminate() 
    Next 
End Function 

Call main 

Answer 1

これは、すべてのExcelファイルをPDFファイルに変換します。

Sub Convert_Excel_To_PDF() 
    Dim MyPath As String, FilesInPath As String 
    Dim MyFiles() As String, Fnum As Long 
    Dim mybook As Workbook 
    Dim CalcMode As Long 
    Dim sh As Worksheet 
    Dim ErrorYes As Boolean 
    Dim LPosition As Integer 

    'Fill in the path\folder where the Excel files are 
    MyPath = "c:\Documents and Settings\shuerya\Desktop\ExcelFiles\" 

    FilesInPath = Dir(MyPath & "*.xl*") 
    If FilesInPath = "" Then 
     MsgBox "No files found" 
     Exit Sub 
    End If 

    Fnum = 0 
    Do While FilesInPath <> "" 
     Fnum = Fnum + 1 
     ReDim Preserve MyFiles(1 To Fnum) 
     MyFiles(Fnum) = FilesInPath 
     FilesInPath = Dir() 
    Loop 

    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    If Fnum > 0 Then 
     For Fnum = LBound(MyFiles) To UBound(MyFiles) 
      Set mybook = Nothing 
      On Error Resume Next 
      Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) 
      On Error GoTo 0 

      If Not mybook Is Nothing Then 


        LPosition = InStr(1, mybook.Name, ".") - 1 
        mybookname = Left(mybook.Name, LPosition) 
        mybook.Activate 
        'All PDF Files get saved in the directory below: 
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
         "C:\Documents and Settings\shuerya\Desktop\PDFFiles\" & mybookname & ".pdf", _ 
         Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ 
         :=False, OpenAfterPublish:=False 

      End If 

      mybook.Close SaveChanges:=False 

     Next Fnum 
    End If 

    If ErrorYes = True Then 
     MsgBox "There are problems in one or more files, possible problem:" _ 
      & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" 
    End If 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .Calculation = CalcMode 
    End With 
End Sub 

これで作業できますか？