Word VBAの最近のブログ記事

毎回わざわざ ファイル → 印刷 → 設定:現在のページを印刷 → 印刷 とやるのが面倒くさいのでマクロにしてボタンにしました。あー、楽になった。

Sub PrintActivePage()
    ' ◆◆ 現在のページのみ印刷するマクロ ◆◆
    ActiveDocument.PrintOut Background:=True, Range:=wdPrintCurrentPage
End Sub

応用:

Sub PrintActivePagePlus1()
    ' ◆◆ 現在のページと次のページの2枚を印刷するマクロ ◆◆
    Dim P1, P2
    P1 = Selection.Information(wdActiveEndPageNumber)
    P2 = P1 + 1
    ActiveDocument.PrintOut Background:=True, Range:=wdPrintFromTo, From:=CStr(P1), To:=CStr(P2)
End Sub

先日作成した「[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

Microsoft Office 2007以降では「名前を付けて保存」で「PDF形式」が選択でき、各種Officeファイルを外部の変換ソフトを使わずにPDF化することが可能です。(ただしOffice 2007では「2007 Microsoft Office プログラム用 Microsoft PDF/XPS 保存アドイン」のインストールが必要)

手順としては、ファイルを開いている状態から、

  1. 「名前を付けて保存」(アイコンまたはF12)
  2. 「ファイルの種類」を「PDF形式」に変更する(マウス操作またはTAB+方向キー)
  3. 「保存」をクリック(またはENTERキーを押す)

の4クリックが必要で、割と面倒くさい作業です。

今回はWordに焦点を絞って、これを1クリックで出来るようマクロボタンを作成してみます。

手順

  1. 現在のフォルダを取得
  2. 現在アクティブなWordファイルのファイル名を取得(拡張子あり)
  3. 同じくファイル名を取得(拡張子なし)
  4. PDFの保存パスを設定
  5. SaveAs2メソッドでPDF形式で保存(2007はSaveAsメソッド)

コードです。

Sub SaveAsPDF()

    ' PDFとして保存するWordマクロ(2010以降対応)

    Dim FSO As Object
    Dim strCurPath As String
    Dim strAFN As String
    Dim strAFN2 As String
    Dim strPDFName As String
    
    ' アクティブドキュメントのパスを取得
    strCurPath = ActiveDocument.Path & "\"
    
    ' アクティブドキュメントのファイル名を取得(拡張子あり)
    strAFN = ActiveDocument.Name
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ' アクティブドキュメントのファイル名を取得(拡張子なし)
    strAFN2 = FSO.GetBaseName(strAFN)

    'PDFの保存パスを設定
    strPDFName = strCurPath & strAFN2 & ".pdf"
    
    ' 現在のフォルダにPDFファイルとして保存(2007はSaveAsメソッドで)
    ActiveDocument.SaveAs2 FileName:=strPDFName, FileFormat:=wdFormatPDF

End Sub

あとはボタンに割り当てるだけです。

「リボンのユーザー設定」または「クイックアクセスツールバーのユーザー設定」からアイコンを登録し、「名前の変更」でアイコンと表示名を変更して完了です。

---

発展型としては、複数ファイルを連続してPDF化する、などが考えられます。私の能力では「こうやれば良さそうだな」と思っても実際コード化するのが難しそうです。

仕事が忙しくなると記事がアップされるブログ管理人です。

今回は、構造計算ソフトから吐かれるWordデータがあまりにも酷い書式なのと、大量にあってしかもそれほど頻繁には見ないのと、何より印刷する紙の無駄を省くために4in1のPDFにするマクロを作ってみました。

Sub Print4in1()
'
' Print4in1 Macro
'
    With ActiveDocument.PageSetup
        .TopMargin = MillimetersToPoints(30)
        .BottomMargin = MillimetersToPoints(30)
        .LeftMargin = MillimetersToPoints(30)
        .RightMargin = MillimetersToPoints(20)
    End With

    ActiveDocument.Save

    ActivePrinter = "JUST PDF Driver"
    
    Application.PrintOut FileName:="" _
        , Range:=wdPrintAllDocument _
        , Item:=wdPrintDocumentWithMarkup _
        , Copies:=1 _
        , Pages:="" _
        , PageType:=wdPrintAllPages _
        , Collate:=True _
        , Background:=True _
        , PrintToFile:=False _
        , PrintZoomColumn:=2 _
        , PrintZoomRow:=2 _
        , PrintZoomPaperWidth:=0 _
        , PrintZoomPaperHeight:=0

End Sub

クイックアクセスツールバーに登録して、2クリックでPDFまで作成できて便利です。ActivePrinterのところをいじれば他のPDFライターでもプリンタでも可能です。

 

設計ソフトから出力されたWordファイル、設計ソフト側でそれなりの出力時の書式設定は出来るのですが、これがきっちりとうまく行かないのです。おまけにパラグラフの先頭がページの一番下にあったりと散々です。また、大量に計算をかけるため、これらをいちいち手作業で直していくのが非常に面倒くさくそれだけのために多くの時間を割いてしまいます。

例えばこの単純作業が約1分かかり年間5000ケースくらい計算するとします。そうすると年間5000分=83.3時間、稼働時間7.5時間として、約11日(11工数)もこの単純作業のために費やされることになりますね。非常に無駄なことです。

そこでこれらの作業をマクロ一発で済ましてしまおうと思い立ちました。

余白の設定

特定の文字列の直前に改ページを挿入

これだけあれば何とかなりますが、Word VBAがまったく分からないため、まずはマクロの記録をして必要な部分を抜粋しました。

    ' ページ余白の設定(上:15mm, 下:20mm, 左:25mm, 右:15mm)
    With ActiveDocument.PageSetup
        .TopMargin = MillimetersToPoints(15)
        .BottomMargin = MillimetersToPoints(20)
        .LeftMargin = MillimetersToPoints(25)
        .RightMargin = MillimetersToPoints(15)
    End With

ページ余白の設定は上記の通りです。

    ' 「(3)土質条件」の直前に「改ページ」を挿入する
    With Selection.Find
        .ClearFormatting
        .Text = "(3)土質条件"
        .Execute
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.InsertBreak Type:=wdPageBreak

Selection.Findは「検索オブジェクト」です。With~End With内で順に「検索条件をクリア」→「検索文字列を"(3)土質条件"にして検索」→「検索終了」となります。

次のMoveLeftメソッドで選択範囲が解除され左に一文字カーソルが移動します。つまり「(3)」の直前にカーソルが来ます。

最後のInsertBreakメソッドで改ページ(wdPageBreak)が挿入されます。

 

検索単語が複数出てくる場合は、例えば行数が全部で35あるとして、30行以上なら改行させる処理を挟む、などすれば良いのかなと考えています。

    If Selection.Information(wdFirstCharacterLineNumber) >= 30 Then
        Selection.InsertBreak Type:=wdPageBreak
    End If

SelectionオブジェクトのInformationプロパティでカーソル位置の行数を出しています。

 

ざっと作って30分。これで年間10日程度短縮できるというのが凄いですね。

カスタム検索
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