図1●今回作成するユーザーフォーム
図1●今回作成するユーザーフォーム
[画像のクリックで拡大表示]
リスト1●オートシェイプの名前をリストアップするプロシジャ
リスト1●オートシェイプの名前をリストアップするプロシジャ
[画像のクリックで拡大表示]
リスト2●オートシェイプを画面中央に表示するプロシジャ
リスト2●オートシェイプを画面中央に表示するプロシジャ
[画像のクリックで拡大表示]
リスト3●オートシェイプを最前面に移動するプロシジャ
リスト3●オートシェイプを最前面に移動するプロシジャ
[画像のクリックで拡大表示]
リスト4●オートシェイプを削除するプロシジャ
リスト4●オートシェイプを削除するプロシジャ
[画像のクリックで拡大表示]
リスト5●ユーザーフォームを消し,マクロを終了するプロシジャ
リスト5●ユーザーフォームを消し,マクロを終了するプロシジャ
[画像のクリックで拡大表示]
リスト6●ユーザーフォームを表示するプロシジャ
リスト6●ユーザーフォームを表示するプロシジャ
[画像のクリックで拡大表示]

 ポカポカ陽気と言うよりも,汗ばむ季節? もうじき衣替えですかな。そろそろコタツをしまわなくっちゃ。さて,今回は先月号に引き続き,印刷の怪現象にいどみます。

今月の相談

「データが書かれたテキスト・ファイルをExcelに取り込んで,思い通りの集計を終えた後で印刷したら,集計表の後に真っ白なページが何枚も,何枚も。誰かに恨まれる覚えはないのですが,おはらいが必要でしょうか?」

 白紙のページが印刷される原因は,制御コードと見えないオートシェイプ(線,図形,テキストボックスなどのオブジェクト)です。制御コードについては先月号で解説しました。今月は,見えないオートシェイプの対処法を紹介します。

Shapesプロパティで取得

 オートシェイプがワークシート上にあるのだけれど,どこにあるかわからないという状態には2種類あると考えられます。ホーム(セルA1)から遠く離れた場所にあって画面をひたすらスクロールしなければわからないという場合と,小さすぎたりほかのオートシェイプと重なっていたりして見えない場合です。プロパティで「線なし」(枠線がない状態)と「塗りつぶしなし」に設定した空のオートシェイプも後者に入りますね。

 これらの見えないオートシェイプはどうやって探せばいいのでしょうか?[オブジェクトの選択]ボタンをクリックして,ワークシート上をひたすら範囲指定するのも一つの方法ですが,不確実でスマートではありませんね。やはり,ここはマクロの出番です。今回はユーザーフォーム(ユーザーが独自に作成できるウィンドウやダイアログボックス)を使って,対話型のマクロを作ってみました。ユーザーフォームで使用するコントロールは一つのリストボックスと,四つのコマンドボタンです(図1[拡大表示])。

 まず,ユーザーフォームを表示すると同時に,アクティブシートにあるすべてのオートシェイプの名前をリストボックスに表示するようにしましょう(リスト1[拡大表示])。Initializeイベントのイベント・プロシジャを使うと,ユーザーフォームを表示する前に必要な処理を実行できます。今回は,この中でオートシェイプをリストアップします。

リスト1●オートシェイプの名前をリストアップするプロシジャ

Private Sub UserForm_Initialize()
    Dim S As Shape

    For Each S In ActiveSheet.Shapes
        Me.ListBox1.AddItem S.Name
    Next S
End Sub

 アクティブシート上のすべてのオートシェイプは,Shapesプロパティで取得できます。これを,For Each...Nextステートメントと組み合わせて一つずつ取り出し(1),AddItemメソッドでその名前をリストボックスに追加します(2)。

シェイプを画面中央に表示する

 次に,[画面に表示]ボタン(CommandButton1)のプロシジャを実装します(リスト2[拡大表示])。リストボックスにリストアップされたオートシェイプをクリックして選択し,このボタンをクリックすると画面中央にオートシェイプを表示します。

リスト2●オートシェイプを画面中央に表示するプロシジャ

Private Sub CommandButton1_Click()
    Dim myShape As Shape

    On Error GoTo Er rHandler1
        Set myShape = _
            ActiveSheet.Shapes(Me.ListBox1.Value)
    On Error GoTo 0
    myShape.TopLeftCell.Select
    myShape.Select

Exit Sub
ErrHandler1:
    MsgBox "対象とするオートシェイプを選択してください"
End Sub

 具体的には,シェイプ・オブジェクトがある左上のセルをTopLeftCellプロパティで取得して,Selectメソッドを実行することで,そのセルを画面中央に表示します(1)。そしてシェイプ・オブジェクトのSelectメソッドを実行すると,オートシェイプが選択された状態になります(2)。これで,大きなオートシェイプの後ろに隠れて見えないもの,点ほどの大きさになっていて見えないもの,線なしで見えないものなども,サイズ変更のハンドル(小さな四角)が表示されますので存在を確認できます。

 リスト3[拡大表示]は,[最前面に移動]ボタン(CommandButton2)をクリックしたときに実行されるプロシジャです。ZOrderメソッドの引数にmsoBringToFrontを指定して実行すると,そのオートシェイプは最前面に移動します(1)。

リスト3●オートシェイプを最前面に移動するプロシジャ

Private Sub CommandButton2_Click()
    On Error GoTo ErrHandler1
        ActiveSheet.Shapes(Me.ListBox1.Value).ZOrder _
            msoBringToFront
    On Error GoTo 0

Exit Sub
ErrHandler1:
    MsgBox "対象とするオートシェイプを選択してください"
End Sub

 なおリスト2[拡大表示]とリスト3[拡大表示]では,リストボックスでシェイプを選択しないでボタンをクリックした場合に発生するエラーを,エラートラップで処理しています。

シェイプを削除する

 続いて,見つけたオートシェイプを削除する[削除]ボタン(CommandButton3)のプロシジャを実装します(リスト4[拡大表示])。オートシェイプは,Deleteメソッドで削除します(3)。いったん削除したシェイプ・オブジェクトは元に戻すことができません。削除を実行する前に,メッセージを表示して確認するようにしましょう(2)。オートシェイプを削除した後は,リストボックスから削除したオートシェイプの名前を消します(4)。

リスト4●オートシェイプを削除するプロシジャ

Private Sub CommandButton3_Click()
    Dim myAns As Integer

    If Me.ListBox1.ListIndex = -1 Then
        MsgBox "削除するオートシェイプを選択してください", _
            vbExclamation
    Else
        myAns = MsgBox("削除しますか", vbYesNo + vbQuestion)
        Select Case myAns
            Case vbYes
                ActiveSheet.Shapes(Me.ListBox1.Value).Delete
                Me.ListBox1.RemoveItem (Me.ListBox1.ListIndex)
        End Select
    End If
End Sub

 リスト4[拡大表示]では,リストボックスでオートシェイプを選択しないでボタンをクリックした場合にエラーが発生しないように,事前にListIndexプロパティの値をチェックしています(1)。このプロパティの値が-1のときは,リストボックスのどの要素も選択されていないことを示します。リスト2[拡大表示],リスト3[拡大表示]のエラートラップと同じ働きをします。

 最後に[さよなら~]ボタンのClickプロシジャを記述します(リスト5[拡大表示])。Unloadメソッドで,ユーザーフォームを非表示にし,メモリーを解放します。

リスト5●ユーザーフォームを消し,マクロを終了するプロシジャ

Private Sub CommandButton4_Click()
    Unload Me
End Sub

 おっと,もう一つ肝心なものを忘れてました。ここまでに作成したユーザーフォームを表示するプロシジャを標準モジュールに作っておきましょう(リスト6[拡大表示])。このプロシジャ名(UF1_Show)が今回のマクロ名になります。今回のユーザーフォームは必ずモードレス(vbModeless)で表示してください*1。モーダル(vbModal)で表示すると,正常に機能しない場合があります。

リスト6●ユーザーフォームを表示するプロシジャ

Sub UF1_Show()
    UserForm1.Show vbModeless
End Sub

古庄 潤