2014年3月アーカイブ

先日作成した「[Word VBA] Word文書をWordだけで1クリックでPDF化するマクロボタンを作成する」を応用して、複数ファイル選択してそれらを一発で連続PDF変換するマクロを作ってみました。今回も使うのはWordのみ。Acrobat等は必要ありません。対応はWord 2010, 2013です。一部SaveAs2メソッドをSaveAsに変えればWord2007でも使えそうです。

ファイルの選択には、FileDialog(msoFileDialogFilePicker)を使いました。フィルターでWordファイル(doc/docx/docm)を設定し、AllowMultiSelectをtrueにして複数選択できるようにしています。初期フォルダをマイドキュメントにしたいのでWindows Script HostのShell機能を使います。

SelectedItemsをループさせてファイルを開く(visibleをfalseで)、PDF保存、ファイルを閉じる(保存はしない)、を繰り返します。

※ここでは既に開いているファイルのチェックはしてないので、必要な場合は別途組み込んで下さい。

Sub Exchange2PDF()
    
    On Error Resume Next
    
    ' 選択したWordファイルをPDFとして連続保存するマクロ

    Dim FSO As Object
    Dim WSH As Object
    Dim strCurPath As String
    Dim strAFN As String
    Dim strAFN2 As String
    Dim strPDFName As String
    Dim strActFile As String
    Dim N As Long
    
    Set WSH = CreateObject("WScript.Shell")
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Wordファイル", "*.doc;*.docx;*.docm"
        .FilterIndex = 1
        .InitialFileName = WSH.SpecialFolders("MyDocuments") & "\"
        
        .Title = "PDFに変換したいWordファイルを選択(複数選択可)"
        .AllowMultiSelect = True
        
        If .Show = -1 Then
            For i = 1 To .SelectedItems.Count
                strActFile = .SelectedItems(i)
                
                Documents.Open strActFile, , , , , , , , , , , Visible:=False
                Documents(strActFile).Activate
                
                'PDFに保存する
                Set FSO = CreateObject("Scripting.FileSystemObject")
                strCurPath = ActiveDocument.Path & "\"
                strAFN = ActiveDocument.Name
                strAFN2 = FSO.GetBaseName(strAFN)
                strPDFName = strCurPath & strAFN2 & ".pdf"
                ActiveDocument.SaveAs2 FileName:=strPDFName, FileFormat:=wdFormatPDF
                
                'Wordファイルを保存しないで閉じる
                Documents.Close SaveChanges:=Flase
            Next i
            MsgBox "全てのファイルを変換しました。"
        Else
            MsgBox "キャンセルしました。"
            Exit Sub
        End If
    End With
End Sub
カスタム検索
Access Counter
Powered by Movable Type 4.22-ja

2016年9月

Sun Mon Tue Wed Thu Fri Sat
        1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30