1. プログラム！

前回の記事で表1座標計算シートを作りました、この表の変数行に角度「θ」を入力する事で座標A～Gが自動計算されます。

今回作ったVBAプログラムは上の表で計算した座標を少しずつ変えながらリンクを描画して「テオ・ヤンセン機構」のアニメーションにしています

1.1 導入

前回の記事を参考にEXCELの座標計算シート(表1)をマクロを有効にした「xlsm」拡張子で保存します。

このEXCELファイルを開いた状態で「開発」タブ→「Visual Basic」を押すと「Microsoft Visual Basic for Applications」(VBA)が開きます。

VBA画面左上に「プロジェクト-VBAProject」ウインドウが有り、そこにはファイルのツリー構造が示されていますので、その中から現在編集しているEXCELファイル名(***)の「VBAProject(***_xlsm)」→「Microsoft Excel Objects」→から現在編集しているEXCELのシート名を選択し、下記プログラムコードを張り付けて保存するだけでOKです！

1.2 中身

VBA プログラムの内容は下記のとおりです。

表1変数行に有る角度「θ」の値を10°刻みで変化させ、これを表1の動作角度入力欄に入力した角度(表では360)まで行います。

角度を変化させる都度A～G座標が計算されますので、この値を元にEXCELのオートシェープ(線と丸)の消去と描画を繰り返します。

これら一連の処理を連続して行います。

Sub Worksheet_Change(ByVal TARGET As Excel.Range)

'NOBのArduino日記！(20170823作成)

If TARGET.Address = "$O$4" Then

Dim A As Variant, B As Variant, link As Variant, axis As Variant

A = Array(, 24, 24, 24, 25, 27, 26, 28, 26, 23, 23, 23)

B = Array(, 25, 26, 27, 27, 28, 28, 29, 29, 25, 26, 22)

link = Array(, "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "m")

axis = Array(, , , , , , , , , , , , , , , , , , , , , , "O", "A", "B", "C", "D", "E", "F", "G")

For I = 0 To TARGET.Value Step 10

Range("N7") = I

'オートシェイプ削除

For Each E In ActiveSheet.Shapes

ActiveSheet.Shapes(1).Delete

'b～mのリンク・記号を描画

For j = 1 To UBound(A)

'リンク

With ActiveSheet.Shapes.AddLine(Cells(A(j), 12), Cells(A(j), 13), Cells(B(j), 12), Cells(B(j), 13)).Line

.ForeColor.RGB = RGB(255, 0, 0)

.Weight = 0.75

End With

'リンク記号

ActiveSheet.Shapes.AddShape(msoShapeRectangle, (Cells(A(j), 12) + Cells(B(j), 12)) / 2 - 10, (Cells(A(j), 13) + Cells(B(j), 13)) / 2 - 10, 48.75, 43.5).Select

With Selection.ShapeRange

.Fill.Visible = msoFalse

.Line.Visible = msoFalse

.TextFrame2.TextRange.Characters.Text = link(j)

.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1

.TextFrame2.TextRange.Characters.Font.Size = 11

End With

Next j

'軸ポイント

With ActiveSheet.Shapes

.AddShape msoShapeOval, Cells(22, 12) - 5, Cells(22, 13) - 5, 10, 10 'O

.AddShape msoShapeOval, Cells(24, 12) - 5, Cells(24, 13) - 5, 10, 10 'B