[Excel VBA]Continuous Integration for MS-Office Documents with Excel VBA

大量のWord、Excel,PPTをPDFに変換しないといけない仕事がある。
しかも、全部が完成してるわけじゃないので、修正に応じて再度リリース・・・。
自動化するにきまってます。

下準備

target directory	target filename	destination directory	destination filename	options

って形でシートを作っておく。

Options for Word

target directory	target filename	destination directory	destination filename	fromPage	toPage

fromPageが0なら、全部出力。そうでなければ、指定したページ範囲だけPDF出力。

Options for Excel

target directory	target filename	destination directory	destination filename	targetSheet

Options for PowerPoint

target directory	target filename	destination directory	destination filename	fromPage	toPage	outputFormat

outputFormat={Note,Slide}

Slideにすると、2in1になるようにしている。

マクロ

Excel VBAです。

Option Explicit


' 2014/05/08 kencoba

Public Sub ToPDF()
    Dim i As Integer
    i = 2
    
    With Worksheets("Sheet1")
    
    Do While .Cells(i, 2).Value <> ""
        
        Dim inputDir As String
        Dim inputFile As String
        Dim outputDir As String
        Dim outputFile As String
        
        inputDir = .Cells(i, 1)
        inputFile = .Cells(i, 2)
        outputDir = .Cells(i, 3)
        outputFile = .Cells(i, 4)
        
        Dim target As String
        Dim destination As String
        
        target = inputDir & "\" & inputFile
        destination = outputDir & "\" & outputFile
        
        Dim fs As Object
        Set fs = CreateObject("Scripting.FileSystemObject")
        
        
        Dim targetSheet As String
        Dim fromPage As Integer
        Dim toPage As Integer
        Dim outputFormat As String
        
        
        If LCase(fs.GetExtensionName(target)) = "xls" Or _
            LCase(fs.GetExtensionName(target)) = "xlsx" Then
               
            targetSheet = .Cells(i, 5)
               
            Call Excel2PDF(target, destination, targetSheet)
               
        ElseIf LCase(fs.GetExtensionName(target)) = "doc" Or _
               LCase(fs.GetExtensionName(target)) = "docx" Then
            
            fromPage = .Cells(i, 5)
            toPage = .Cells(i, 6)
            
            Call Word2PDF(target, destination, fromPage, toPage)
            
        ElseIf LCase(fs.GetExtensionName(target)) = "ppt" Or _
               LCase(fs.GetExtensionName(target)) = "pptx" Then
            
            fromPage = .Cells(i, 5)
            toPage = .Cells(i, 6)
            outputFormat = .Cells(i, 7)
            
            Call PPT2PDF(target, destination, fromPage, toPage, outputFormat)
            
        End If
        
        i = i + 1
    Loop
    
    End With
    
End Sub

Private Sub Word2PDF(ByRef target As String, ByRef destination As String, ByVal fromPage As Integer, ByVal toPage As Integer)
  Dim wordObj As Word.Application
  Set wordObj = CreateObject("Word.Application")
  wordObj.Visible = True

  Dim doc As Word.Document
  Set doc = wordObj.Documents.Open(target)
  
  If fromPage = 0 Then
      doc.ExportAsFixedFormat _
          OutputFileName:=destination, _
          ExportFormat:=wdExportFormatPDF
  Else
      doc.ExportAsFixedFormat _
          OutputFileName:=destination, _
          ExportFormat:=wdExportFormatPDF, _
          Range:=wdExportFromTo, _
          From:=fromPage, _
          To:=toPage
  End If
  
  wordObj.Documents.Close

  wordObj.Quit
  Set wordObj = Nothing
End Sub

Private Sub Excel2PDF(ByRef target As String, ByRef destination As String, ByVal targetSheet As String)
  Dim excelObj As Excel.Application
  Set excelObj = CreateObject("Excel.Application")
  excelObj.Visible = True

  Dim book As Excel.Workbook
  Set book = excelObj.Workbooks.Open(target)
  
  Dim xlSheet As Excel.Worksheet
  Set xlSheet = book.Worksheets(targetSheet)

  xlSheet.ExportAsFixedFormat xlTypePDF, destination, xlQualityStandard

  book.Close

  excelObj.Quit
  Set excelObj = Nothing
End Sub

Private Sub PPT2PDF(ByRef target As String, ByRef destination As String, ByVal fromPage As Integer, ByVal toPage As Integer, ByVal outputFormat As String)
  Dim pptObj As PowerPoint.Application
  Set pptObj = CreateObject("PowerPoint.Application")
  pptObj.Visible = True

  Dim pres As PowerPoint.Presentation
  Set pres = pptObj.Presentations.Open(target)
  
  Dim prng As PrintRange
  pres.PrintOptions.Ranges.ClearAll
  Set prng = pres.PrintOptions.Ranges.Add(fromPage, toPage)

  If outputFormat = "Note" Then
        pres.ExportAsFixedFormat _
            Path:=destination, _
            FixedFormatType:=ppFixedFormatTypePDF, _
            outputType:=ppPrintOutputNotesPages, _
            PrintHiddenSlides:=msoTrue, _
            PrintRange:=prng
  ElseIf outputFormat = "Slide" Then
        pres.ExportAsFixedFormat _
            Path:=destination, _
            FixedFormatType:=ppFixedFormatTypePDF, _
            outputType:=ppPrintOutputTwoSlideHandouts, _
            FrameSlides:=msoTrue, _
            PrintHiddenSlides:=msoTrue, _
            PrintRange:=prng
  End If

  pres.Close

  pptObj.Quit
  Set pptObj = Nothing
End Sub