一般的なプログラムの実行

Excel VBA によるプログラミング教育用環境の創製

木 原

寛

目 的

Ｅｘｃｅｌ ＶＢＡのモジュールとして、基本グラフィックス機能やタートルグラフィックス機能を用

意し、昔の

N88-BASIC のように、誰でも手軽に利用できる環境を提供する。

Excel は大多数のパソコンで利用可能であり、Macintosh でも使える。

したがって、高校の必修科目として新しく取り入れられた「教科 情報

B」の実習などでも利

用可能である.

基本グラフィックス描画機能の追加

直線や円の描画などの基本的なグラフィックス命令を、旧来の BASIC と同様な使い勝手で利

用できるように用意する。

' 物理座標グラフィックス

Sub Line(x1, y1, x2, y2, Optional cLineRGB) Sub LineB(x1, y1, x2, y2, Optional cLineRGB)

Sub LineB(x1, y1, x2, y2, Optional cLineRGB, Optional cAreaRGB) Sub Circle(x, y, rx, Optional ry, Optional cLineRGB)

' World 座標グラフィックス Sub InitializeGraphics()

Sub SetViewPort(ViewLeft, ViewTop, ViewRight, ViewBottom)

Sub SetGraphicsWindow(WindowLeft, WindowTop, WindowRight, WindowBottom)

Sub DrawLine(x1, y1, x2, y2, Optional cLineRGB) Sub DrawRectangle(x1, y1, x2, y2, Optional cLineRGB)

Sub DrawRectangleFill(x1, y1, x2, y2, Optional cLineRGB, Optional cAreaRGB) Sub DrawOval(x, y, rx, Optional ry, Optional cLineRGB)

Sub DrawOvalFill(x, y, rx, Optional ry, Optional cLineRGB, Optional cAreaRGB) Sub gcls()

Sub PointSet(x, y, Optional cLineRGB) ‘ PSET Sub Move(x, y) ‘ POINT Sub DrawPolyLine(x, y, n)

Sub gClear() 'グラフィック・オブジェクトの消去

Turtle グラフィックス描画機能の追加

Turtle グラフィックス命令を、LOGO と同様な使い勝手で利用できるように用意する。

' Turtle グラフィックス

Sub InitializeTurtleGraphics() Sub TGTurn(a)

Sub TGMove(length)

Sub TGMoveL(length, Optional cRGBLine) Sub TGSetPoint(x0, y0)

Sub TGSetAngle(a0) Sub TGRightTurn(a) Sub TGLeftTurn(a)

基本グラフィックス関数による描画の例

Sub spiral() ' ARCIMEDES' SPIRALE

Dim i As Integer, x As Single Dim r As Single, d As Single Dim x1 As Single, x2 As Single Dim y1 As Single, y2 As Single

Const P4 = 4 * 3.14159 Const x0 = 200 Const y0 = 300 Const da = 0.1 InitializeGraphics For i = 0 To 12 For x = 0 To P4 Step da r = 12 * x d = 12 * i x1 = Cos(x) * r + x0 + d y1 = y0 - d - Sin(x) * r x2 = Cos(x + da) * r + x0 + d y2 = y0 - d - Sin(x + da) * r

Call DrawLine(x1, y1, x2, y2) Next x Next i End Sub Sub Kaleidoscope() InitializeGraphics r = Val(Right$(Time$, 2)) Randomize (r) x = Rnd(1) * 10 c = QBColor(Int(Rnd(1) * 16)) For A = 0 To 199 Step x + 2 Call DrawLine(A, 0, 199 - A, 199, c) Call DrawLine(399 - A, 0, 200 + A, 199, c) Call DrawLine(A, 399, 199 - A, 200, c) Call DrawLine(399 - A, 399, 200 + A, 200, c) Next A x = x ¥ 2 For B = 0 To 199 Step x + 2 Call DrawLine(0, 199 - B, 199, B, c) Call DrawLine(200, B, 399, 199 - B, c) Call DrawLine(0, 200 + B, 199, 399 - B, c) Call DrawLine(399, 200 + B, 200, 399 - B, c) Next B End Sub

多角形描画や座標変換の例

Sub PolygonTest() Dim x(20), y(20) Dim i InitializeGraphics SetViewPort 10, 10, 479, 479 SetGraphicsWindow -2, 3, 3, -2 For i = 3 To 8 RegularPolygon x, y, i DrawPolygon x, y, i Next i End Sub Sub RotationTest() Dim x(20), y(20) Dim i Dim RotationAngle InitializeGraphics SetViewPort 10, 10, 479, 479 SetGraphicsWindow -3, 3, 3, -3 gLineColor = vbBlue RotationAngle = 30 RegularPolygon x, y, 3 Translation x, y, 3, 1, 0 DrawPolygon x, y, 3 For i = 1 To 12 Rotation x, y, 3, RotationAngle DrawPolygon x, y, 3 Next i End Sub

Turtle グラフィックス関数による描画の例

Sub TurtleTest2()

Dim length, angle, d, c

d = 0.005 length = 1# angle = 89 InitializeGraphics SetViewPort 10, 10, 489, 489 SetGraphicsWindow 0, 1.2, 1.2, 0 c = QBColor(9) TGSetPoint 0.1, 0.1 Do While length > d TGMoveL length, c TGTurn angle length = length - d Loop End Sub Sub DrawKochCurve() Dim i, length, N N = 4 ' コッホ次数 length = 60 ' ０次の長さ InitializeGraphics SetViewPort 10, 10, 489, 489 SetGraphicsWindow 0, 5000, 5000, 0 TGSetPoint 500, 2000 TGSetAngle 0 For i = 1 To 3 Koch N, length TGTurn -120 Next i End Sub

Sub Koch(N, length) If N = 0 Then

TGMoveL length, QBColor(1) ' 水色 Else Koch N - 1, length TGTurn 60 Koch N - 1, length TGTurn -120 Koch N - 1, length TGTurn 60 Koch N - 1, length End If End Sub

エクセルに無い有用な関数の追加の例

行列や行列式の計算、座標変換、非線形最小自乗法など、よく使われる機能を使用可能とする. 例 行列の計算 1 -2 3 9 1 7 -1.810 -0.952 -0.143 -4 5 -6 -3 10 3 -1.619 -0.905 -0.286 7 -8 2 13 -1 4 -0.143 -0.286 -0.143 8 3 4 -7 -5 -1 1 5 9 -5 0 -15 6 7 2 1 -15 0 2 -1 4 1 2 -2 -1 2 -1 2 1 0 1 2 -1 0 2 1 1 -1 2 3 -1 0 -2 -1 1 4 -7 1 3 0 -1 2 1 2 行列Ａ 行列Ｂ 行列P 行列Q 行列PとQの積 行列Ａの逆行列 行列ＡとＢの和 行列ＡとＢの差 22 2 -1 Sub MtrxTest()

Dim A(10, 10) As Double, B(10, 10) As Double, C(10, 10) As Double

' 行列Ａ、B の読み込み MtrxInput A, 3, 3, 2, 1 MtrxInput B, 3, 3, 7, 1 MtrxAdd A, B, C, 3, 3 MtrxOut C, 3, 3, 2, 5 MtrxSub A, B, C, 3, 3 MtrxOut C, 3, 3, 7, 5 MtrxInv A, 3 MtrxOut A, 3, 3, 2, 9 ' 行列 P、Q の読み込み MtrxInput A, 3, 5, 13, 1 MtrxInput B, 5, 3, 13, 7 MtrxMult A, B, C, 3, 5, 3 MtrxOut C, 3, 3, 13, 11 End Sub

一般的なプログラムの実行 あらかじめエクセルのシートにデータ領域を設定しておけば、VBA コード中での入出力の指定が簡単になり、 N88-BASIC などによる昔のプログラムの移植も容易になります。（ここで扱っている題材そのものは一般的では ありませんが。） A ライフゲーム 初期状態 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 1 2 3 4 5 6 7 8 1 1 9 1 1 10 1 11 12 13 14 15 16 17 18 19 20 20 ステップ後 20 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 1 2 3 4 1 5 1 1 6 1 7 1 1 1 1 8 1 1 9 1 1 1 10 1 1 1 1 1 11 1 1 1 12 1 1 1 13 1 14 15 16 17 18 19 20 プログラム メイン部 Sub LifeGameOneStep() ' 1 step ずつ実行 次に進むには F5 キーを押す Call Rule Call Init_Mask

Do While Generation < Max_Iteration Call New_Generation Call Board Stop Loop End Sub

B 単純ヒュッケル分子軌道法計算（量子化学） 同様に、たとえば行列形式のデータ出力関数を用意しておけば、エクセルのシートにデータ領域を設定する ことにより、VBA コード中での入出力の指定が簡単になるため、処理内容に関する知識があれば短時間の学習 でプログラムの作成が可能となります。 データ入力シート 単純ヒュッケル分子軌道法計算プログラム 　　　 Written by H. KIHARA 化合物名 原子数 4 結合数 3 π電子数 4 永年行列 （結合が存在する時、１を入力する。） 1 2 3 4 5 6 7 8 9 10 11 1 1 2 1 3 1 4 1 5 6 7 8 9 10 11 12 Butadiene 2 計算結果の出力シート 化合物名 Butadiene 原子数 4 結合数 3 π電子数 4

Eigen Values and Eigen vectors

--1 2 3 1.618 0.618 -0.618 -1.618 1 0.372 -0.602 -0.602 -0.372 2 0.602 -0.372 0.372 0.602 3 0.602 0.372 0.372 -0.602 4 0.372 0.602 -0.602 0.372 Bond Order Matrix

--1 2 3 1 1.000 2 0.894 1.000 3 0.000 0.447 1.000 4 4

プログラムメイン部 ' ヒュッケル分子軌道法計算のプログラム Option Explicit Option Base 1 Const M = 12 ' 配列の大きさ Dim Title As String

Dim NA As Integer ' 原子番号 Dim NB As Integer ' 結合数 Dim NP As Integer ' π電子数 Dim G(M, M) As Double ' 永年行列 Dim V(M, M) As Double ' 固有ベクトル Dim P(M, M) As Double ' 結合次数 Sub HMO() Worksheets("Input").Select

Title = Cells(4, 2).Value: ' 化合物名 NA = Cells(5, 2).Value: ' 原子数 NB = Cells(6, 2).Value: ' 結合数 NP = Cells(7, 2).Value: ' π電子数 Call SECDET: '永年行列の読み込み Call DIAG: 'ヤコビ法による対角化 Call INCRE: '固有ベクトルの並べ替え Call PMAT: '結合次数の計算 Call POUT: '結果の出力 End Sub