はじめに
オートシェイプでメーター風のインターフェースを作ってみました。目盛をプログラムで作図し全体をグループ化しています。改造すれば、目盛を調整する事もできます。
指示針は、数値で指定できるので感覚的に使う事ができます。
プログラム解説
プログラムは、メーター文字盤の作成と、指示針の制御にわかれています。
メーター文字盤の作成は1回行えばOKです。目盛や表記文字（数値）はプログラムで位置決めしており、最後にグループ化しています。
指示針の制御は、数値で指定すれば指示針に角度を付けて表示してくれます。
メーター文字盤作成プログラム
最初にグローバル変数として、メーター目盛盤のシェイプ名と、指示針のシェイプ名を保持するようにします。
Private myMeterName As String '"Group 58"
Private myNeedleName As String '"Straight Connector 59"
'メータ指示板と指示針を描画（実行するとmyMeterName、myNeedleNameは更新されます。）
Sub buildMeter()
Dim rng As Range: Set rng = Range("H17") 'メーター指示の起点
Dim cLineLeft As Single: cLineLeft = rng.Left '起点
Dim cLineTop As Single: cLineTop = rng.Top
Dim sLineLeft As Single
Dim sLineTop As Single
Dim eLineLeft As Single
Dim eLineTop As Single
Dim myTextBox As Shape 'ラベル
Dim myTB_w As Long: myTB_w = 40 'ラベル幅
Dim myTB_h As Long: myTB_h = 24 'ラベル高さ
Dim myLine As Shape '指示針
Dim myL_long As Long: myL_long = 135 '目盛大
Dim myL_mid As Long: myL_mid = 130 '目盛中
Dim myL_short As Long: myL_short = 125 '目盛小
Dim sAngle As Long: sAngle = 15 'メーター開始角
Dim eAngle As Long: eAngle = 165 'メーター終了角
Dim div As Long: div = 50 '刻み
Dim ang As Double '1目盛あたりの角度
ang = (eAngle - sAngle) / div
Dim i As Long, l As Long
Dim flag As Boolean
Dim cnt As Long, shpCnt As Long
cnt = 0
shpCnt = 0
Dim a As Double
For i = 0 To div '15°～165° 1目盛 3°
flag = False
If i Mod 10 = 0 Then
l = myL_long
flag = True
ElseIf i Mod 5 = 0 Then
l = myL_mid
Else
l = myL_short
End If
a = (i * ang) + sAngle
eLineLeft = cLineLeft - l * Cos(a / 45 * Atn(1))
eLineTop = cLineTop - l * Sin(a / 45 * Atn(1))
sLineLeft = cLineLeft - 120 * Cos(a / 45 * Atn(1))
sLineTop = cLineTop - 120 * Sin(a / 45 * Atn(1))
Set myLine = ActiveSheet.Shapes.AddLine(sLineLeft, sLineTop, eLineLeft, eLineTop)
shpCnt = shpCnt + 1
myLine.Line.ForeColor.RGB = RGB(0, 0, 0)
myLine.Line.Transparency = 0
'Shapeの選択（最後にグループ化する）
If shpCnt = 1 Then
myLine.Select
Else
myLine.Select Replace:=False
End If
If flag Then
eLineLeft = cLineLeft - 150 * Cos(a / 45 * Atn(1))
eLineTop = cLineTop - 150 * Sin(a / 45 * Atn(1))
Set myTextBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
eLineLeft - (myTB_w / 2), _
eLineTop - (myTB_h / 2), _
myTB_w, _
myTB_h)
'Shapeの選択（最後にグループ化する）
myTextBox.Select Replace:=False
' テキストボックスにテキストを設定
With myTextBox
.TextFrame.Characters.Text = cnt
cnt = cnt + 1
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignCenter
.TextFrame2.TextRange.Font.Size = 16
.Rotation = a - 90
.Line.Visible = msoFalse
.Fill.Visible = msoFalse
End With
End If
Next i
'メータ部分をグループ化
Selection.ShapeRange.Group.Select
Debug.Print Selection.Name
myMeterName = Selection.Name
'指示針
eLineLeft = cLineLeft - 140 * Cos(15 / 45 * Atn(1))
eLineTop = cLineTop - 140 * Sin(15 / 45 * Atn(1))
Set myLine = ActiveSheet.Shapes.AddLine(cLineLeft, cLineTop, eLineLeft, eLineTop)
myLine.Line.ForeColor.RGB = RGB(0, 0, 0)
myLine.Line.Transparency = 0
myLine.Line.Weight = 2
Debug.Print myLine.Name
myNeedleName = myLine.Name
rng.Select
End Subこのプログラムでは、放射状に並んだ目盛の作図が基本となります。放射状に並ぶ目盛の延長線上に円の中心があり、本プログラムでは H17 セルの左上を円の中心として作図しています。
メーター目盛の作図
目盛線は、上の図で p – p’ を作図すれば良い事になります。
p点と、p’ 点は円周上の点なので、中心点を a (cLeft, cTop) とすると以下の式から求める事ができます。
p = ( cLeft + r ・ cosθ , eLeft + r ・ sinθ )
ｐ’点については r を変えれば得られます。
θ については、弧度法（ラジアン）を用いるため、以下のような式で求められます。
（説明は省略します。）
Cos( 角度 / 45 * Atn(1))
Sin( 角度 / 45 * Atn(1))
目盛盤テキストボックス
目盛盤のテキストボックス（1～５）の表示位置は以下の手順で行います。
１．テキストボックスを作成する際、Left, Top を P’ の延長線上に合わせます。
更に、文字がテキストボックスの中心となるように調整します。
２．次に、テキストボックスの中心が先程の Left, Top の位置になるように移動します。
（新たに Left, Top の位置を変更する。）
３．最後に放射状の角度に合わせてテキストボックスを回転させます。
角度は、角度表示の θ – 90° にします。
これを目盛表示したい場所で作図していきます。
目盛の拡張
今回は、1～５までの 50 刻みで目盛を配置していますが、変数の値を適切に変更すれば異なったバージョンの目盛盤を作ることもできます。
Dim sAngle As Long: sAngle = 15 'メーター開始角
Dim eAngle As Long: eAngle = 165 'メーター終了角
Dim div As Long: div = 50 '刻み
目盛の開始角度は、sAngle で 15°、終了角度は、eAngle で 165° となっています。
この間隔を div の数値で刻みます。ここでは 50 で刻んでいます。
グループ化
作図が済んだら、全ての目盛とテキストボックスをグループ化します。こうする事で扱いが楽になるでしょう。
指示針の作成
指示針は目盛とは別に作成して、後から動かせるようにします。取り敢えず 0 （15°）を指すようにして作成しておきます。
指示針を動かすプログラム
指示針を動かすプログラムは、2つのプロシージャで構成されています。1つは指示針の始点と終点を計算するプロシージャ（moveNeedle）。もう1つは、始点と終点から直線図形（シェイプ）の位置を変更するプロシージャ（setMyConnector）です。
'指示針を d値にセット
Sub moveNeedle(d As Double)
myNeedleName = "Straight Connector 59" '指示針オブジェクト名を指定
Dim rng As Range
Dim cLineLeft As Single
Dim cLineTop As Single
Dim eLineLeft As Single
Dim eLineTop As Single
Dim myLine As Shape
'//既定値
Set rng = Range("H17") 'moveNeedle
'中心
cLineLeft = rng.Left
cLineTop = rng.Top
Dim ang As Double '15°～165° 1目盛 3°
Dim n As Long '大目盛
n = 5
ang = 150 / n '大目盛１あたりの角度 150°
ang = d * ang + 15
'指示値
eLineLeft = cLineLeft - 140 * Cos(ang / 45 * Atn(1))
eLineTop = cLineTop - 140 * Sin(ang / 45 * Atn(1))
Call setMyConnector(myNeedleName, cLineLeft, cLineTop, eLineLeft, eLineTop)
End Sub
'オブジェクト名と始点、終点で位置をセット
'sName:オブジェクト名 始点：stLeft（左）、stTop（上） 終点：eLeft（左）、eTop（上）
Sub setMyConnector(sName As String, stLeft As Single, stTop As Single, eLeft As Single, eTop As Single)
If IsObject(ActiveSheet.Shapes(sName)) = False Or sName = "" Then
Debug.Print "オブジェクトがありません。"
Exit Sub
End If
With ActiveSheet.Shapes(sName)
.Left = IIf(stLeft < eLeft, stLeft, eLeft)
.Top = IIf(stTop < eTop, stTop, eTop)
.Width = Abs(stLeft - eLeft)
.Height = Abs(stTop - eTop)
If stLeft > eLeft Then
If Not .HorizontalFlip Then .Flip msoFlipHorizontal
Else
If .HorizontalFlip Then .Flip msoFlipHorizontal
End If
If stTop > eTop Then
If Not .VerticalFlip Then .Flip msoFlipVertical
Else
If .VerticalFlip Then .Flip msoFlipVertical
End If
End With
End Sub指示針の始点と終点を計算
moveNeedleでは値を引数に取って、そこから指示針の始点と終点を計算します。
直線シェイプ名に関しては、作図した時のシェイプ名を直接指定しています。
始点に関しては、メーター指示の起点とした H17 セルの左上のポイントとなります。終点は、引数値から角度を割り出して、円周までの半径で計算します。
始点と終点が決まったら、2点の位置に指示針のシェイプを移動するために setMyConnector を呼び出します。
始点と終点から直線図形（シェイプ）の位置を変更する
オートシェイプでは、左上の位置と幅、高さの値で図形の位置と大きさを指定する仕様になっています。
このため、直線のように始点と終点で直接指定する事ができません。
変換は、左（.Left）と、上（.Top）の小さい方をそれぞで、.Left, .Top の値として取り、そこから幅（.Width）と、高さ（.Height）を得ます。さらに直線の向きにより Flip メソッドを使って適切に直線の方向を反転させる必要があります。（結構面倒です！）
setMyConnector では、シェイプ名、始点の左、上の位置と終点の左、上の位置から、直線シェイプのプロパティ値を変更します。
その他のプログラム
本プログラムでは、シェイプ名をグローバル変数で取っていますが、作図してから再度ファイルを立ち上げた際、グローバル変数のシェイプ名は失われてしまうので指示針は動かなくなってしまいます。
そこで、moveNeedle 内で指示針のシェイプ名を直接指定しています。
自身でメーター目盛を作成した際は、シェイプ名を書き換えるのを忘れないで下さい。
スクロールバーの制御
スクロールバーは、メニューの「開発」＞「挿入」のActiveXコントロールのスクロールバーを使用しています。ブックオープンの際に、スクロールバーの最大値を 500 に変更しています。
' ThisWorkbookモジュールに記述
Private Sub Workbook_Open()
Worksheets(1).ScrollBar1.Max = 500
End Sub更にメーターがある Sheet1 には、スクロールバーの Changeイベントで以下のコードを書いています。
'Sheet1モジュールに記述
Private Sub ScrollBar1_Change()
'Debug.Print Me.ScrollBar1.Value * 0.01
Call moveNeedle(Me.ScrollBar1.Value * 0.01)
End Subメーターは 50刻みで１目盛が、0.1ですが、スクロールバーは 500刻みで 0.01 をかけますので目盛よりも細かく指示針が動く事になります。
まとめ
扱い方のコツとしては、起点となる H17 セルと、シェイプ名の指定に気を付けるようにしてください。
仕事柄、このようなメーターは良く目にしています。研修や教育などの資料作りなどで役立てて頂ければ幸いです。質問等ありましたら、こちらまでどうぞ。
コメント