お気楽工作日記

VBAでメーターの文字盤を作る

素材状態↓

加工途中の素材↓

ＶＢＡのソースはこんな感じです↓
モーグの“即効テクニック > ExcelVBA > 図形操作関連のテクニック”
http://www.moug.net/index.html
を参考に作ってみました。相変わらず、見よう見まねでやっているので妙なことをやっているかもしれません。

Private Sub CommandButton1_Click()

Dim MyLine As Shape

Const PIE As Single = 3.1415926535

Xc = 300 'メーターの中心
Yc = 300 'メーターの中心

r1 = 120 'メーター中央部の円
r2 = 160 'メーター中央部の円
r3 = 490 'メーター外周の円

r11 = 200 '小目盛り　半径（内側）
r12 = 220 '小目盛り　半径（外側）

r21 = 200 '大目盛り　半径（内側）
r22 = 240 '大目盛り　半径（外側）

kakudo_stat = 140 '目盛り開始角度
kakudo_end = 400 '目盛り終了角度
kakudo_step1 = 50 '小目盛り分割数
kakudo_step2 = 10 '大目盛り分割数

'メーター外周（正方形）、メーター外周（円）、メーター中央部の円

Set MyLine = Sheet2.Shapes.AddShape(msoShapeRectangle, 50, 50, 500, 500) 'メーター外周（正方形）

Set MyLine = Sheet2.Shapes.AddShape(msoShapeOval, Xc - r3 / 2, Yc - r3 / 2, r3, r3) 'メーター外周（円）

Set MyLine = Sheet2.Shapes.AddShape(msoShapeOval, Xc - r2 / 2, Yc - r2 / 2, r2, r2) 'メーター中央部の円

Set MyLine = Sheet2.Shapes.AddShape(msoShapeOval, Xc - r1 / 2, Yc - r1 / 2, r1, r1) 'メーター中央部の円

'小目盛り
step1 = (kakudo_end - kakudo_stat) / kakudo_step1
For i = kakudo_stat To kakudo_end Step step1

X1 = Cos(i * 2 * PIE / 360) * r11 + Xc
Y1 = Sin(i * 2 * PIE / 360) * r11 + Yc

X2 = Cos(i * 2 * PIE / 360) * r12 + Xc
Y2 = Sin(i * 2 * PIE / 360) * r12 + Yc

Set MyLine = Sheet2.Shapes.AddLine(X1, Y1, X2, Y2)

With MyLine
.Line.Weight = 2
End With

Next i

'大目盛り

step2 = (kakudo_end - kakudo_stat) / kakudo_step2
For i = kakudo_stat To kakudo_end Step step2

X1 = Cos(i * 2 * PIE / 360) * r21 + Xc
Y1 = Sin(i * 2 * PIE / 360) * r21 + Yc

X2 = Cos(i * 2 * PIE / 360) * r22 + Xc
Y2 = Sin(i * 2 * PIE / 360) * r22 + Yc

Set MyLine = Sheet2.Shapes.AddLine(X1, Y1, X2, Y2)

With MyLine
.Line.Weight = 3
End With

Next i

'小目盛り脇の弧

X1old = Cos(kakudo_end * 2 * PIE / 360) * r11 + Xc
Y1old = Sin(kakudo_end * 2 * PIE / 360) * r11 + Yc

X2old = Cos(kakudo_end * 2 * PIE / 360) * r12 + Xc
Y2old = Sin(kakudo_end * 2 * PIE / 360) * r12 + Yc

For i = kakudo_stat To kakudo_end Step 1

X1 = Cos(i * 2 * PIE / 360) * r11 + Xc
Y1 = Sin(i * 2 * PIE / 360) * r11 + Yc

X2 = Cos(i * 2 * PIE / 360) * r12 + Xc
Y2 = Sin(i * 2 * PIE / 360) * r12 + Yc

Set MyLine = Sheet2.Shapes.AddLine(X1old, Y1old, X1, Y1)
With MyLine
.Line.Weight = 2
End With

Set MyLine = Sheet2.Shapes.AddLine(X2old, Y2old, X2, Y2)
With MyLine
.Line.Weight = 2
End With

X1old = X1
Y1old = Y1

X2old = X2
Y2old = Y2

Next i

End Sub

CommandButton1をシート１に配置し、メーターはシート２に描いています。
で、素材の加工が終わったら、これも、シート１に配置したCommandButton2↓
を押して、すべての図形を選択状態にして、手動でグループ化します。

Private Sub CommandButton2_Click()

Sheet2.Shapes.SelectAll '---全ての図形を選択

End Sub

全部一気に消したい場合には、同じようにすべての図形を選択状態にして、手動で削除すればＯＫです。

トラ技付録のＵＳＢマイコンボード
電子工作　メニュー
HOME