特集記事

ExcelとWordで簡易ドキュメント・データベースを作る

VBAによるアプリケーション連携プログラミング

瀬戸遥[著]

更新日: 2008/08/26
公開日: 2007/01/11

ポスト

ダウンロードソースコード (2.2 KB)
ダウンロードサンプルファイル（Excel・Word） (37.7 KB)

ワークシート・バージョンのコード作成

　最初に、ワークシートバージョンのマクロを作成しましょう。コードは、Excel VBAの標準モジュールModule1に作成します。

Wordの起動処理－リスト1

　最初に、Wordを起動し、指定した文書を開く処理を作成します。プロジェクトに、Wordに対する参照設定を行なってください。

　この処理は、汎用のプロシージャとして作成します。処理そのものはWord文書を開いて終了させますが、他のプロシージャでWord内の検索処理を行うため、作成したWordのインスタンスへの参照が必要になります。

　そこで、このインスタンスへの参照が戻り値となるよう、Functionプロシージャを作成し、引数に開く文書のファイル名を指定するようにします。プロシージャ名は「Word_Doc_Open」で、オブジェクトへの参照を戻り値とする場合は、そのオブジェクト型をプロシージャに設定します。

Function Word_Doc_Open(ByVal DocName As String) As Word.Application

　Wordの起動は、CreateObject関数を使用してインスタンスを作成します。そして、DocumentsオブジェクトのOpenメソッドで引数の文書を開きます。

Dim Wd As Word.Application
Dim WDoc As Word.Document

'Wordのインスタンスを作成し該当のテキストファイルを開く
Set Wd = CreateObject("Word.Application")
Set WDoc = Wd.Documents.Open(DocName)
Wd.Visible = True

　無事、Wordで文書を表示できたら、このインスタンスへの参照をプロシージャの戻り値にセットします。そして、使用したオブジェクト変数を開放します。

    Set Word_Doc_Open = Wd

    Set Wd = Nothing
    Set WDoc = Nothing
End Function

　これで出来上がりです。オブジェクトへの参照を変数にセットする場合は、Setステートメントを使用する点に注意してください。

文書内のTipsコード検索・コピー処理－リスト2

　今度は、Subプロシージャ「Code_Copy」でWord文書内のTipsコードを検索しコピーする処理を作成します。この処理は、Wordの検索・ブックマーク・コピー機能を使用し、すべてWordに対する操作を行います。

ここでは、コードをコピーするために次の方法を使用します。
1. まずコードの先頭行を把握します。そのために、「Sub」という文字列を検索し、その行番号を把握すると共に、ここにブックマークを付けます。
2. 次に、「Sub」をスタート位置に「End Sub」という文字を検索します。そして、この行番号を把握します。
3. 「End Sub」の行番号から「Sub」の行番号を差し引くと、コード全体の行数が分かります。ブックマーク機能を使ってカーソルを「Sub」行に移動し、ここからコードの行数分を選択します。
4. 選択範囲を対象にCopyメソッドを実行します。

文書内を検索するには、SelectionオブジェクトのFindプロパティを使用し、Findオブジェクトを取得してこのオブジェクトの各プロパティやメソッドを操作します。
プロシージャ名は「Code_Copy」で、引数にWordのインスタンスへの参照を設定します。
```
Sub Code_Copy(ByRef Wd As Word.Application)

    Dim Nsub As Integer, Nend As Integer

    With Wd.Selection.Find
```

前回の検索文字列が入力されて残っている場合に備え、あらかじめこれをClearFormattingメソッドでクリアしておきます。
```
.ClearFormatting
```

Textプロパティに「Sub」という検索文字列をセットします。Forwardプロパティで検索方向を下方向に、Wrapプロパティで検索方法を検索範囲の先頭または末尾に到達したときに検索操作を続けるようにセットします。
MatchFuzzyプロパティに検索時に日本語の文字列のあいまい検索を行うよう指示し、Executeメソッドで検索を実行します。
```
    .Text = "Sub"
    .Forward = True
    .Wrap = wdFindContinue
    .MatchFuzzy = True
    .Execute
End With
```

検索が成功するとその文字が選択状態になりますので、その位置にブックマークを付けておきます。
ブックマークの追加は、BookmarksコレクションのAddメソッドを使用します。引数Rangeに設定位置をWordのRangeオブジェクトで指定し、引数Nameにブックマーク名を設定します。
```
Wd.ActiveDocument.Bookmarks.Add _
        Range:=Wd.Selection.Range, Name:="sub"
```

ブックマークを付けると同時に、その位置の行番号を変数Nsubに格納しておきます。
カーソル位置の行数を把握するには、SelectionオブジェクトのInformationプロパティに定数wdFirstCharacterLineNumberをセットして参照します。

なお、ここでは文書内のコードはページをまたいで作成されていないことを前提にしています。
```
Nsub = Wd.Selection.Information(wdFirstCharacterLineNumber)
```

次に、文字列「End Sub」を検索します。使い方は文字列「Sub」の検索と同様です。

検索したら、その位置の行番号を取得し、変数Nendに格納しておきます。

With Wd.Selection.Find
    .ClearFormatting
    .Text = "End Sub"
    .Forward = True
    .Wrap = wdFindContinue
    .MatchFuzzy = True
    .Execute
End With

Nend = Wd.Selection.Information(wdFirstCharacterLineNumber)

文字列「Sub」と「End Sub」の行番号が把握できたら、カーソルを文字列「Sub」に移動します。これは、SelectionオブジェクトのGoToメソッドを使用します。引数にブックマーク名を指定するとその位置にカーソルが移動します。
そして、その位置を開始位置に、MoveDownメソッドでコードの行数分を選択状態にします。
```
With Wd.Selection
    .GoTo What:=wdGoToBookmark, Name:="sub"
    .MoveDown Unit:=wdLine, Count:=(Nend - Nsub) + 1, Extend:=wdExtend
```

コード全体が選択できたら、SelectionオブジェクトのCopyメソッドで
コードをクリップボードにコピーします。

これで、コードのコピー処理が出来上がりです。
```
        .Copy
    End With
End Sub
```

メインの検索処理－リスト3

　最後に、検索処理全体を受け持つマクロ用プロシージャ「ドキュメントデータベース」を作成します。

　クリックされたTipsタイトルのセルから、タイトル文字列を取得すると共に、そのセルを含むカテゴリのセル範囲からカテゴリ名を取り出し、文書ファイル名の取得とTipsタイトルの検索を行います。文書の表示は、作成したFunctionプロシージャ「Word_Doc_Open」を使い、Tipsタイトルの検索後にプロシージャ「Code_Copy」を実行して、該当するコードをコピーします。

　そして、ワークシートSheet2にコードをペーストしますが、この時見やすいように新しいウィンドウを開いてコードを表示します。

まず、クリックされているTipsタイトルが入力されているセル位置から、そのカテゴリ全体のセル範囲を取得します。
例えば、セルB1が選択されていれば、このTipsタイトルが所属するカテゴリ「セルを操作する」全体のセル範囲「A1:B13」を取得します。

この処理は、RangeオブジェクトのCurrentRegionプロパティを使用します。このプロパティは、空白行と空白列で囲まれたセル範囲をRangeオブジェクトで返すプロパティです（このプロパティを使用するために、Sheet1の各カテゴリは空白行で区切っています）。

そして、このセル範囲が取得できたら、そのままRangeオブジェクトのAddressプロパティでセル番地を取得し、変数BaseAddressに格納します。ただし、そのままでは「$A$1:$B$13」という文字列が返ってきてしまうので、Addressプロパティの引数RowAbsolute、ColumnAbsoluteにFalseをセットし、「A1:B13」という文字列を取得するようにします。
```
BaseAddress = ActiveCell _
              .CurrentRegion.Address(RowAbsolute:=False, _
                                     ColumnAbsolute:=False)
```

選択されているTipsタイトルのセル（現在アクティブなセル）から、Tipsタイトルの文字列を取得し、変数SearchStrに格納します。そして、一度Excelを最小化します。
```
SearchStr = ActiveCell

Application.WindowState = xlMinimized
```

格納しておいたカテゴリのセル範囲から、カテゴリ名が格納してある範囲の先頭のアドレスを取得します。
While－WendループとMid関数を使用し、変数BaseAddressから「:」の直前までの文字列を取り出し、変数ADSに格納します。これで、例えばカテゴリのセル範囲が「A1:B13」であれば、「A1」というセル番地を取り出すことができます。
```
While C <> ":"
    i = i + 1
    C = Mid(BaseAddress, i, 1)
    If C <> ":" Then
        ADS = ADS & C
    End If
Wend
```

取り出したセル番地を参照し、格納されているカテゴリ名を取り出します。このカテゴリ名は、そのままコードを格納してあるファイル名になっていますので、パス名とファイルの拡張子をつけてWordの文書ファイル名にします。
```
Fname = "C:\" & Worksheets("Sheet1").Range(ADS) & ".doc"
```

注意

　なお、このサンプルでは「セルを操作する.doc」しか入っていないため、これ以外のカテゴリのTipsタイトルを選んでマクロを実行させるとエラーになってしまします。そこで、ここではこのエラーを回避するために、次のコードを組み込んであります。

If Fname <> "C:\セルを操作する.doc" Then
    MsgBox "ファイルがありません"
    Exit Sub
End If

文書ファイル名が作成できたら、Wordを起動し文書を開きます。
これは、既に作成してあるFunctionプロシージャ「Word_Doc_Open」を実行します。必ず、Functionプロシージャの戻り値である、Wordのインスタンスへの参照を、オブジェクト変数に格納するのを忘れないでください。
```
Set Wd = Word_Doc_Open(Fname)
```

文書が開けたらTipsタイトルを検索します。コードの検索と同様、WordのSelectionオブジェクトとFindオブジェクトを使って、変数SearchStrに格納されているTipsタイトルを検索します。
```
With Wd.Selection.Find
    .ClearFormatting '前回の検索入力をクリア
    .Text = SearchStr
    .Forward = True
    .Wrap = wdFindContinue
    .MatchFuzzy = True
    .Execute
End With
```

検索が成功すると、そのTipsタイトルの位置にカーソルが移動しますので、ここを開始位置にしてコードの検索を行います。これは、既に作成してあるプロシージャ「Code_Copy」を呼び出すだけです。
これで、セルに入力されているTipsタイトルを検索し、そのタイトルのコードを拾い出すことができるようになっています。
```
Call Code_Copy(Wd)
```

クリップボードへのコードのコピーが済んだら、Wordを終了します。
開いた文書にはブックマークが設定されていますので、そのままWordを終了すると文書保存のメッセージボックスが表示されてしまいます。

そのため、まずDocumentオブジェクトのCloseメソッドの引数SaveChangesにwdDoNotSaveChangesを設定して、文書を保存せずに閉じた後に、ApplicationオブジェクトのQuitメソッドでWordを終了させます。

終了したら、使用していたオブジェクト変数を開放し、最小化していたExcelを元の表示に戻します。
```
With Wd
    .ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    .Quit
End With
Set Wd = Nothing

Application.WindowState = xlNormal
```

今度は、クリップボードにコピーしたコードを、ワークシートSheet2に貼り付けます。
まず、WindowオブジェクトのNewWindowメソッドで、新しいウィンドウを開きSheet2をアクティブにします。Excelでは、ウィンドウごとに表示できるワークシートを指定できます。

なお、現在のウィンドウ表示が最大化されていると、次に行うウィンドウのサイズ設定操作がエラーになってしまうため、ウィンドウの表示状態をチェックし、最大化表示であれば一度標準表示に戻してから新しいウィンドウを開くようにしています。
```
    If ActiveWindow.WindowState = xlMaximized Then
    ActiveWindow.WindowState = xlNormal
End If
ActiveWindow.NewWindow
Worksheets("Sheet2").Activate
```

次に、列Aに前回のコードが入力されている場合があるので、それをRangeオブジェクトのClearContentsメソッドでクリアします。そして、セルA1を選択してWorksheetオブジェクトのPasteメソッドを実行します。
これで、コードをSheet2のセルA1にペーストできました。
```
With ActiveSheet
    Columns("A:A").Select
    Selection.ClearContents
    .Range("A1").Select
    .Paste
    .Range("A1").Select
End With
```

後は表示するウィンドウを整形します。まず、WindowオブジェクトのDisplayGridlinesプロパティで枠線を非表示にし、Top・Leftプロパティでウィンドウの表示位置を、Width・Heightプロパティでウィンドウのサイズを設定します。

以上で出来上がりです。Tipsタイトルをクリックしマクロを実行すると、対応したコードが別ウィンドウで表示されます。
```
    With ActiveWindow
        .DisplayGridlines = False
        .Top = 250
        .Left = 200
        .Width = 400
        .Height = 200
    End With
End Sub
```

次のページ
ユーザフォームバージョンのコード作成

この記事は参考になりましたか？

印刷用を表示

ポスト

特集記事連載記事一覧: 開発者のための「WWDC 2024」関連発表まとめ

LeSSやSAFeなど、大規模アジャイルにおけるソフトウェア品質の課題とは？

【オンライン技術書読書会のはじめかた】完璧じゃなくていい、雑談の延長線で開催してみませんか...

もっと読む

この記事の著者: 瀬戸遥（セトハルカ）

8ビットコンピュータの時代からBASICを使い、C言語を独習で学びWindows 3.1のフリーソフトを作成、NiftyServeのフォーラムなどで配布。Excel VBAとVisual Basic関連の解説書を中心に現在まで40冊以上の書籍を出版。近著に、「ExcelユーザーのためのAccess再...

※プロフィールは、執筆時点、または直近の記事の寄稿時点での内容です

この著者の最近の執筆記事