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

Excel VBA によるプログラミング 教 育 用 環 境 の 創 製 木 原 寛 目 的 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 () 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 TGBackward(length, Optional crgbline)

基 本 グラフィックス 関 数 による 描 画 の 例 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 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 Sub Kaleidoscope() 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

多 角 形 描 画 や 座 標 変 換 の 例 Sub PolygonTest() Dim x(20), y(20) Dim i SetViewPort 10, 10, 479, 479 SetGraphicsWindow -2, 3, 3, -2 For i = 3 To 8 RegularPolygon x, y, i Next i DrawPolygon x, y, i Sub RotationTest() Dim x(20), y(20) Dim i Dim RotationAngle 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

Turtle グラフィックス 関 数 による 描 画 の 例 Sub TurtleTest2() Dim length, angle, d, c d = 0.005 length = 1# angle = 89 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 Sub DrawKochCurve() Dim i, length, N N = 4 length = 60 ' コッホ 次 数 ' 0 次 の 長 さ 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 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 ' 水 色

エクセルに 無 い 有 用 な 関 数 の 追 加 の 例 行 列 や 行 列 式 の 計 算 座 標 変 換 非 線 形 最 小 自 乗 法 など よく 使 われる 機 能 を 使 用 可 能 とする. 例 行 列 の 計 算 行 列 A 行 列 AとBの 和 行 列 Aの 逆 行 列 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 行 列 B 行 列 AとBの 差 8 3 4-7 -5-1 1 5 9-5 0-15 6 7 2 1-15 0 行 列 P 行 列 Q 行 列 PとQの 積 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 22 2-1 Sub MtrxTest() Dim A(10, 10) As Double, B(10, 10) As Double, C(10, 10) As Double ' 行 列 A 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

一 般 的 なプログラムの 実 行 あらかじめエクセルのシートにデータ 領 域 を 設 定 しておけば 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

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

プログラムメイン 部 ' ヒュッケル 分 子 軌 道 法 計 算 のプログラム 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: ' 結 果 の 出 力