category name  »  page title date

矢印つきメッセージ

ワークシート上にメッセージを表示したいことがよくあります。
単に、こうすればいいのですが

ActiveSheet.Range("B2").Value = "こんにちは"

もう少し上等な機能をもった関数を作ってみました。

IndicateMessage()

決められたセル（ここでは、"MessageCell"という名前のついたセル）に、指定されたインデントつきで、必要なら矢印を伴ってメッセージを表示する、というものです。
たとえば、左のような感じ。

矢印は、あらかじめ右のようなものを png 画像として作成し、所定の位置に配置しておきます。IndicateMessage はこれを隠しておいて、必要な時に必要な矢印が見えるようにします。矢印画像の Shape 名は決められた接頭語（ここでは "ArrowLine"）の後にハイフン "-" を介して、２桁の数値番号をつけておきます（Shape の名付けは、「図の形式」メニューの中の「オブジェクトの選択と表示」を開いて行えます）。
表示する文字のサイズと色は、ここでは 10pt と赤に固定しました。

IndicateMessage()

'----- IndicateMessage を表示するセル名
Private Const messageCellName = "MessageCell"
'----- 文字のサイズと色
Private Const messageFontSize = 10
Private Const messageFontColorIndex = 3
'----- ArrowLine の名前の接頭語
Private Const arrowPrefix = "ArrowLine"

'----- 指示メッセージの表示
Public Sub IndicateMessage( _
    msg, Optional spaceCount = 0, Optional arrowNum = -1 _
    )
      On Error Resume Next
      clearArrowLines
      With ActiveSheet.Range(messageCellName)
            .Font.Size = messageFontSize
            .Font.ColorIndex = messageFontColorIndex
            .Value = Space(spaceCount) & msg
      End With
      If arrowNum >= 0 Then _
            ActiveSheet.Shapes( _
                arrowPrefix & "-" & Format(arrowNum, "00") _
                ).Visible = True
End Sub
'----- すべての ArrowLine を消去する
Private Sub clearArrowLines()
Dim arrowSp, a
      For Each arrowSp In ActiveSheet.Shapes
            a = Split(arrowSp.Name, "-")
            If a(0) = arrowPrefix Then arrowSp.Visible = False
      Next
End Sub

こうやって使います。

IndicateMessageDemo()

Sub IndicateMessageDemo()
    IndicateMessage "矢印もインデントもなし"
    IndicateMessage "インデント２０", 20
    IndicateMessage "メッセージ表示のテスト", 10, 0
End Sub