【VBA】ワードファイルの空白ページを削除する

2019.03.20

エクセルVBAでよく使うコードの備忘録。VBAでワードファイルを操作して、ドキュメントに含まれる空白ページを削除するコード。

スポンサーリンク

事前準備

VBAでワードファイルを操作するには、参照設定が必要です。VBAのコードエディタから「ツール > 参照設定」と進み、「Microsoft Word XX.X Object Library」にチェックを入れておきます。

空白ページを削除する

下記のサンプルコードでは、ワードドキュメント内のすべてのページを走査して、空白のみのページを削除しています。空白ページの定義としては「半角・全角スペース」、「セクション区切り」、「ページ区切り」、「改行」以外の文字が含まれないページとしています。コードを使用する際はカッコに囲まれた部分（[***]）を自分のプログラムに合わせて変更してください。

サンプルコード

Public Sub DeleteBlankPage()
    '--- Wordのアプリケーションオブジェクト ---'
    Dim objWord As Word.Application
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    
    '--- ドキュメントオブジェクト ---'
    Dim objDoc As Word.Document
    Set objDoc = objWord.Documents.Open("[ワードファイルのパス]")
    
    '--- ドキュメントのページ数を取得 ---'
    Dim pageN As Long
    pageN = objDoc.Content.Information(wdNumberOfPagesInDocument)
    
    '--- ドキュメントの冒頭にカーソルを移動 ---'
    objDoc.Activate
    objWord.Selection.Start = 0
    objWord.Selection.End = 0
    
    '--- 各ページの最初と最後を格納する変数 ---'
    Dim startTmp As Long
    Dim endTmp As Long
    
    '--- 各ページの内容を格納する変数 ---'
    Dim tmp As String
    
    '--- 全てのページを走査 ---'
    Dim i As Long
    For i = 1 To pageN
        'iページに移動
        Call objWord.Selection.Goto(What:=wdGoToPage, which:=wdGoToFirst, Count:=i)
        
        'iページのスタートとエンドを取得
        startTmp = objWord.Selection.Start
        
        '最終ページでない時
        If (i < pageN) Then
            '一度次のページの冒頭にカーソルを移動し一つ戻る（そこがページの最後）
            Call objWord.Selection.Goto(What:=wdGoToPage, which:=wdGoToFirst, Count:=i + 1)
            endTmp = objWord.Selection.Start - 1
            
        '最終ページの時
        Else
            '文書の最後に移動
            Call objWord.Selection.EndKey(Unit:=wdStory)
            endTmp = objWord.Selection.End
            
        End If
        
        'iページ全体を選択
        objWord.Selection.Start = startTmp
        objWord.Selection.End = endTmp
        
        'iページに含まれる文字列を取得
        tmp = objWord.Selection.Text
        
        'iページに含まれる文字列から空白とみなす文字列を削除
        tmp = Replace(tmp, " ", "")         '半角スペース
        tmp = Replace(tmp, "　", "")        '全角スペース
        tmp = Replace(tmp, "^b", "")        'セクション区切り
        tmp = Replace(tmp, "^m", "")        'ページ区切り
        tmp = Replace(tmp, Chr(12), "")     '改行
        tmp = Replace(tmp, vbCr, "")        '改行
        tmp = Replace(tmp, vbCrLf, "")      '改行
        tmp = Replace(tmp, vbLf, "")        '改行
        tmp = Replace(tmp, vbNewLine, "")   '改行
        
        'iページに含まれる文字列が空欄のみ、あるいは一文字も含まれない場合は削除
        If (tmp = "" Or startTmp = endTmp) Then
            objWord.Selection.Start = Application.WorksheetFunction.Max(startTmp - 1, 0)
            objWord.Selection.End = endTmp + 1
            objWord.Selection.Delete
        End If
        
    Next i
    
    '--- ドキュメントを閉じる ---'
    objDoc.Close
    
    '--- ワードを閉じる ---'
    objWord.Quit

End Sub
スポンサーリンク