職場のノートパソコンでやってみたところ、
画面の小ささのためにやたらスクロールして
よく見えないということがわかりました。
そういう場合に変更したらいい箇所にコメントをつけました。
セルの大きさを変更しましょう。
画面の小ささのためにやたらスクロールして
よく見えないということがわかりました。
そういう場合に変更したらいい箇所にコメントをつけました。
セルの大きさを変更しましょう。
「万華鏡」マクロの中に文字化けを発見しましたので、直しました。
と、一度直したらまた戻ってしまっていました。普通の文章の中では使われない文字の並びがブログ画面に出ると制御コード扱いになるのか消えてしまってキャリッジリターンを消し、次の行まで道連れにしてしまうようなのです。リターンをいくつか繰り返して解決しました。
よく見るとまだ改善すべきところがあります。
いつか気が向いたら改善するかもしれません。
しかしデバッグとは懐かしい言葉です。
昔は「机上デバッグ」という言葉がありました。今は機上ですね。おそらく机上の機上。人によっては飛行機の中で。
基本的に初期画面はまっくろですが、できあがった画面から続けて実行したい場合は、
>'開始画面 hajimeの値
>' 0:現在の状態 1:まっくろ 2:まっしろ 0<hajime<56
>hajime = 1
ここの数字↑が"1"になっているのを"0"に、つまり"hajime = 0" に変更してからやってみてください。
あんまり何度も繰り返すと危険ですから、適当なところでExcelを終了してください。
と、一度直したらまた戻ってしまっていました。普通の文章の中では使われない文字の並びがブログ画面に出ると制御コード扱いになるのか消えてしまってキャリッジリターンを消し、次の行まで道連れにしてしまうようなのです。リターンをいくつか繰り返して解決しました。
よく見るとまだ改善すべきところがあります。
いつか気が向いたら改善するかもしれません。
しかしデバッグとは懐かしい言葉です。
昔は「机上デバッグ」という言葉がありました。今は機上ですね。おそらく机上の機上。人によっては飛行機の中で。
基本的に初期画面はまっくろですが、できあがった画面から続けて実行したい場合は、
>'開始画面 hajimeの値
>' 0:現在の状態 1:まっくろ 2:まっしろ 0<hajime<56
>hajime = 1
ここの数字↑が"1"になっているのを"0"に、つまり"hajime = 0" に変更してからやってみてください。
あんまり何度も繰り返すと危険ですから、適当なところでExcelを終了してください。
あそびマクロ第２作はセルラーオートマトンでした。手許のファイルは2001年9月6日の日付がついています。おや、まだそのくらいしか経ってないんですね。当時読んでいた、タイトルは忘れましたがPaul Daviesの本にセルラーオートマトンのことがちょっと書かれていたのでやってみたくなり、それにはExcelがぴったりなのでした。
貝殻の模様のような、自然に存在する模様のできかたを人工的にやってみるもの。
onのセルには●印が入っており、offのセルは空です。onとoffの並び方が簡単な規則に従って模様になります。
最初の行はランダムに●が入りますが、２行目以下は上の行のひとつ左のセルと上の行のひとつ右のセルが同じでない場合に●が入ります。これで全体に大小の三角の模様ができていきます。
最初の行をランダムでなく何かの倍数のときに●にするなどして遊ぶと、たいしたことないながらもちょっとばかり発見があります。
作った当時使っていたのは窓機でしたが今の私のMacではセルと●の大きさが合ってないのでセルの高さを調節する必要があります。●よりもセル自体に色をつけた方がわかりやすいかもしれません。このマクロがやっていることは手作業でもできるので、マクロがよくわからないけど興味ある方は手作業でやってみてください。
その後もっと複雑なのを作ろうという気になりませんでした。作られたのを動かしてみたことはありますが、ただそこまで。Excelでは実行に時間がかかるのがわかっている以上に、作ってみたところでそんなにわくわくするような発見がない、そこからまた新たな発想へ繋がりそうにないという予感があったのです。
生き物が自分で展開するのにこういうやり方をときには使っていそうですが、生命の決定的なところとはまた別という感じ。
しかしこういうひとりでに展開する単純な規則があるのを実感するのはいい経験でした。
Sub cellularautomaton()
'注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。
Cells.Select
Selection.Delete Shift:=xlUp
Selection.ColumnWidth = 0.85
Selection.RowHeight = 6.75
With Selection.Font
.Size = 6
End With
Randomize
For i = 2 To 80
If Int(Rnd * 2) = 1 Then Cells(1, i) = "●"
Next i
For i = 2 To 100
For j = 2 To 80
If Cells(i - 1, j - 1) = Cells(i - 1, j + 1) Then Cells(i, j) = "" Else Cells(i, j) = "●"
Next j
Next i
End Sub
貝殻の模様のような、自然に存在する模様のできかたを人工的にやってみるもの。
onのセルには●印が入っており、offのセルは空です。onとoffの並び方が簡単な規則に従って模様になります。
最初の行はランダムに●が入りますが、２行目以下は上の行のひとつ左のセルと上の行のひとつ右のセルが同じでない場合に●が入ります。これで全体に大小の三角の模様ができていきます。
最初の行をランダムでなく何かの倍数のときに●にするなどして遊ぶと、たいしたことないながらもちょっとばかり発見があります。
作った当時使っていたのは窓機でしたが今の私のMacではセルと●の大きさが合ってないのでセルの高さを調節する必要があります。●よりもセル自体に色をつけた方がわかりやすいかもしれません。このマクロがやっていることは手作業でもできるので、マクロがよくわからないけど興味ある方は手作業でやってみてください。
その後もっと複雑なのを作ろうという気になりませんでした。作られたのを動かしてみたことはありますが、ただそこまで。Excelでは実行に時間がかかるのがわかっている以上に、作ってみたところでそんなにわくわくするような発見がない、そこからまた新たな発想へ繋がりそうにないという予感があったのです。
生き物が自分で展開するのにこういうやり方をときには使っていそうですが、生命の決定的なところとはまた別という感じ。
しかしこういうひとりでに展開する単純な規則があるのを実感するのはいい経験でした。
Sub cellularautomaton()
'注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。
Cells.Select
Selection.Delete Shift:=xlUp
Selection.ColumnWidth = 0.85
Selection.RowHeight = 6.75
With Selection.Font
.Size = 6
End With
Randomize
For i = 2 To 80
If Int(Rnd * 2) = 1 Then Cells(1, i) = "●"
Next i
For i = 2 To 100
For j = 2 To 80
If Cells(i - 1, j - 1) = Cells(i - 1, j + 1) Then Cells(i, j) = "" Else Cells(i, j) = "●"
Next j
Next i
End Sub
コッホ曲線のExcelマクロは2003年11月に作りました。
一番上の一番左のセル(A1)に０から５までの数字のどれかを入れて実行すると、数字が大きいほど複雑な線を引きます。
微妙な数字を使ってますが、誤差が累積したらいやだなと思ったからです。そのせいで傾きが60の倍数度でないのが残念。でもそういえば全体に左右対称だし。実は適当な数字にしても問題なしでした。そういうのがさっとひらめく頭になりたいものです。表には見えないけど割り切れるというだけでもなんとなくすっきりするのでそのままにしてます。
Sub Koch()
'コッホ曲線
'A1のセルに複雑さのレベルを表す数字0から5までのどれかを入れて実行してください。
'もしそれ以外を入れて実行すると0から5までのランダムな値を取ります。
' 注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。
'何度も実行を繰返すと動きが重くなって危険です。数回実行する度に保存せずに終了してください。
a$ = Cells(1, 1)
c = Int(Val(a$))
If c <0 Or c > 6 Then c = Int(Rnd * 6)
XL = 222.75 / (3 ^ c): YL = 384.75 / (3 ^ c)
t = 3 '1:左60度 2:右120度 3:左60度
m = 3 '1:右上2:右3:右下4:左下5:左6:左上
x1 = 20: y1 = 300
ActiveWindow.DisplayGridlines = False
Cells.Select
Selection.Delete Shift:=xlUp
For b = 1 To 4 ^ c
If t = 2 Then m = m + 2 Else m = m - 1
m = (m + 5) Mod 6 + 1
On m GoTo m1, m2, m3, m4, m5, m6
m1: x2 = x1 + XL: y2 = y1 - YL: GoTo m9
m2: x2 = x1 + XL * 2: y2 = y1: GoTo m9
m3: x2 = x1 + XL: y2 = y1 + YL: GoTo m9
m4: x2 = x1 - XL: y2 = y1 + YL: GoTo m9
m5: x2 = x1 - XL * 2: y2 = y1: GoTo m9
m6: x2 = x1 - XL: y2 = y1 - YL
m9:
ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
For I = c To 1 Step -1
If b Mod (4 ^ I) = 0 Then t = b / (4 ^ I) Mod 4: GoTo ddd
Next I
t = b Mod 4
ddd:
x1 = x2: y1 = y2
Next b
Cells(1, 1).Select
Cells(1, 1) = c
End Sub
一番上の一番左のセル(A1)に０から５までの数字のどれかを入れて実行すると、数字が大きいほど複雑な線を引きます。
微妙な数字を使ってますが、誤差が累積したらいやだなと思ったからです。そのせいで傾きが60の倍数度でないのが残念。でもそういえば全体に左右対称だし。実は適当な数字にしても問題なしでした。そういうのがさっとひらめく頭になりたいものです。表には見えないけど割り切れるというだけでもなんとなくすっきりするのでそのままにしてます。
Sub Koch()
'コッホ曲線
'A1のセルに複雑さのレベルを表す数字0から5までのどれかを入れて実行してください。
'もしそれ以外を入れて実行すると0から5までのランダムな値を取ります。
' 注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。
'何度も実行を繰返すと動きが重くなって危険です。数回実行する度に保存せずに終了してください。
a$ = Cells(1, 1)
c = Int(Val(a$))
If c <0 Or c > 6 Then c = Int(Rnd * 6)
XL = 222.75 / (3 ^ c): YL = 384.75 / (3 ^ c)
t = 3 '1:左60度 2:右120度 3:左60度
m = 3 '1:右上2:右3:右下4:左下5:左6:左上
x1 = 20: y1 = 300
ActiveWindow.DisplayGridlines = False
Cells.Select
Selection.Delete Shift:=xlUp
For b = 1 To 4 ^ c
If t = 2 Then m = m + 2 Else m = m - 1
m = (m + 5) Mod 6 + 1
On m GoTo m1, m2, m3, m4, m5, m6
m1: x2 = x1 + XL: y2 = y1 - YL: GoTo m9
m2: x2 = x1 + XL * 2: y2 = y1: GoTo m9
m3: x2 = x1 + XL: y2 = y1 + YL: GoTo m9
m4: x2 = x1 - XL: y2 = y1 + YL: GoTo m9
m5: x2 = x1 - XL * 2: y2 = y1: GoTo m9
m6: x2 = x1 - XL: y2 = y1 - YL
m9:
ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
For I = c To 1 Step -1
If b Mod (4 ^ I) = 0 Then t = b / (4 ^ I) Mod 4: GoTo ddd
Next I
t = b Mod 4
ddd:
x1 = x2: y1 = y2
Next b
Cells(1, 1).Select
Cells(1, 1) = c
End Sub
あそびマクロ第一作は「雪」でした。Windows95に慣れてきた頃。通勤の地下鉄の中でちらしの裏にコーディング、職場のお昼休みにパソコンに入れてテスト、さんざん試行錯誤してできあがりました。当時自宅で使っていたパソコンはMacで、Excelも使えなかったので。その頃の私の環境でプログラミング可能なのはExcelだけでした。
アスタリスクの雪がちらちらと降ってくっついて、その形を万華鏡で映したような形ができあがります。たまに雪らしい形ができます。タイトルは期待させすぎでした。
これを見て、やはり雪はただランダムに水がくっついてできるわけじゃないんだなあと思えました。
十数年ぶりのプログラミングで、無駄なことも結構やっていますがその時はそれしかできず、その後はちょっと日数があくとわけわからなくなってそのままにしてます。いつかはもっとスマートな方法で作りたいと思っていましたが、今はもっと美しい形になるのじゃないと作りたくない気分。
砂時計が矢印に変わって、あれ？雪の結晶なんて出ないじゃないか、と思ってひと呼吸おいた頃に雪の結晶（ということにしといてください）があらわれます。どうかあたたかい目で見てくださいますように。
Sub yuki()
'2001年5月27日
'箱田桂子
'雪…に見えることもたまにはあります。
'******* 注意*******
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'何度も実行すると重くなるので、１回実行する度にExcelを終了することをおすすめします。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。また、出来上がった画面を保存する場合は別のブックにコピーしたものをお使いください。
Cells.Select
Selection.Delete Shift:=xlUp
Selection.ClearContents
Selection.ColumnWidth = 1
Selection.RowHeight = 10.5
With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Range("A50").Select
ActiveWindow.ScrollRow = 1
Dim tate As Integer, yoko As Integer, ookisa As Byte, cc As Single, ss As Single
Dim endflg As Byte, nextflg As Byte, tonari As Byte, haba As Byte
Dim hen1 As Byte, hen2 As Byte, hen3 As Byte
Dim ido As Integer, xcore As Single, ycore As Single
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single
'全体の大きさを決める(必ず偶数)
Randomize
'ookisa = Int(10 * Rnd + 5) * 2
ookisa = 12
Cells(ookisa, 1) = "*" '中心
endflg = 0
haba = 5: xcore = 400: ycore = 200
'-------------------
While endflg = 0
yoko = Int(ookisa * Rnd + 1) '開始地点決定
tate = 1
If Cells(tate, yoko) = "*" Then endflg = 1 '開始地点既に*が入っていれば終了
Cells(tate, yoko) = "*"
'周囲の状況
nextflg = 0
While nextflg = 0
tonari = 0
If yoko > 1 Then If Cells(tate, yoko - 1) = "*" Then tonari = 1
If tate + yoko <ookisa + 1 Then If Cells(tate, yoko + 1) = "*" Then tonari = 1
If tate > 1 Then If Cells(tate - 1, yoko) = "*" Then tonari = 1
'隣が空いていたらそこに移動
If tonari Then nextflg = 1: GoTo kettei
Cells(tate, yoko) = ""
ido = Int(3 * Rnd) - 1
yoko = yoko + ido
If yoko <1 Then yoko = 2
If ido Then GoTo yokoido
tateido:
If tate Mod 2 = yoko Mod 2 Then
tate = tate + 1
Else
' tate = tate - 1 'この行やる暇ある？
If tate <1 Then tate = 1
GoTo kettei
yokoido:
If yoko <1 Then yoko = 2 '左端
If tate + yoko > ookisa And ido > 0 Then yoko = yoko - 1 '右端
Cells(tate, yoko) = "*"
Wend 'nextflg onで終了
Wend 'endflg onで終了
'-------------
For tate = ookisa - 2 To 1 Step -1
For yoko = (tate Mod 2) + 1 To ookisa - tate + 1 Step 2
hen1 = 0: hen2 = 0: hen3 = 0
'隣と同じかどうか
If yoko > 1 Then If Cells(tate, yoko) <> Cells(tate, yoko - 1) Then hen1 = 1 '＼
If tate + yoko <ookisa Then If Cells(tate, yoko) <> Cells(tate, yoko + 1) Then hen2 = 1 '／
If tate > 1 Then If Cells(tate, yoko) <> Cells(tate - 1, yoko) Then hen3 = 1 '－
If tate = 1 Then If Cells(tate, yoko) = "*" Then hen3 = 1
'隣と違えば線を引く
For tonari = 1 To 6 'tonari再利用:円を六等分
For ido = -1 To 1 Step 2 'ido再利用
cc = Cos(tonari / 3 * 3.14)
ss = Sin(tonari / 3 * 3.14)
x1 = xcore + ((ookisa - tate) * cc + (yoko - 1) / 2! * ss * ido) * haba
y1 = ycore + ((ookisa - tate) * ss - (yoko - 1) / 2! * cc * ido) * haba
x2 = xcore + ((ookisa - tate + 1) * cc + (yoko - 2) / 2! * ss * ido) * haba
y2 = ycore + ((ookisa - tate + 1) * ss - (yoko - 2) / 2! * cc * ido) * haba
x3 = xcore + ((ookisa - tate + 1) * cc + yoko / 2! * ss * ido) * haba
y3 = ycore + ((ookisa - tate + 1) * ss - yoko / 2! * cc * ido) * haba
If hen1 Then
ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 41
Selection.ShapeRange.Line.Visible = msoTrue
End If
If hen2 Then
ActiveSheet.Shapes.AddLine(x1, y1, x3, y3).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 41
Selection.ShapeRange.Line.Visible = msoTrue
End If
If hen3 Then
ActiveSheet.Shapes.AddLine(x2, y2, x3, y3).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 41
Selection.ShapeRange.Line.Visible = msoTrue
End If
Next ido
Next tonari
Next yoko
Next tate
Range("A1").Select
End Sub
アスタリスクの雪がちらちらと降ってくっついて、その形を万華鏡で映したような形ができあがります。たまに雪らしい形ができます。タイトルは期待させすぎでした。
これを見て、やはり雪はただランダムに水がくっついてできるわけじゃないんだなあと思えました。
十数年ぶりのプログラミングで、無駄なことも結構やっていますがその時はそれしかできず、その後はちょっと日数があくとわけわからなくなってそのままにしてます。いつかはもっとスマートな方法で作りたいと思っていましたが、今はもっと美しい形になるのじゃないと作りたくない気分。
砂時計が矢印に変わって、あれ？雪の結晶なんて出ないじゃないか、と思ってひと呼吸おいた頃に雪の結晶（ということにしといてください）があらわれます。どうかあたたかい目で見てくださいますように。
Sub yuki()
'2001年5月27日
'箱田桂子
'雪…に見えることもたまにはあります。
'******* 注意*******
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'何度も実行すると重くなるので、１回実行する度にExcelを終了することをおすすめします。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。また、出来上がった画面を保存する場合は別のブックにコピーしたものをお使いください。
Cells.Select
Selection.Delete Shift:=xlUp
Selection.ClearContents
Selection.ColumnWidth = 1
Selection.RowHeight = 10.5
With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Range("A50").Select
ActiveWindow.ScrollRow = 1
Dim tate As Integer, yoko As Integer, ookisa As Byte, cc As Single, ss As Single
Dim endflg As Byte, nextflg As Byte, tonari As Byte, haba As Byte
Dim hen1 As Byte, hen2 As Byte, hen3 As Byte
Dim ido As Integer, xcore As Single, ycore As Single
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single
'全体の大きさを決める(必ず偶数)
Randomize
'ookisa = Int(10 * Rnd + 5) * 2
ookisa = 12
Cells(ookisa, 1) = "*" '中心
endflg = 0
haba = 5: xcore = 400: ycore = 200
'-------------------
While endflg = 0
yoko = Int(ookisa * Rnd + 1) '開始地点決定
tate = 1
If Cells(tate, yoko) = "*" Then endflg = 1 '開始地点既に*が入っていれば終了
Cells(tate, yoko) = "*"
'周囲の状況
nextflg = 0
While nextflg = 0
tonari = 0
If yoko > 1 Then If Cells(tate, yoko - 1) = "*" Then tonari = 1
If tate + yoko <ookisa + 1 Then If Cells(tate, yoko + 1) = "*" Then tonari = 1
'隣が空いていたらそこに移動
If tonari Then nextflg = 1: GoTo kettei
Cells(tate, yoko) = ""
ido = Int(3 * Rnd) - 1
yoko = yoko + ido
If yoko <1 Then yoko = 2
tateido:
If tate Mod 2 = yoko Mod 2 Then
tate = tate + 1
Else
' tate = tate - 1 'この行やる暇ある？
If tate <1 Then tate = 1
yokoido:
If yoko <1 Then yoko = 2 '左端
If tate + yoko > ookisa And ido > 0 Then yoko = yoko - 1 '右端
Wend 'nextflg onで終了
Wend 'endflg onで終了
'-------------
For tate = ookisa - 2 To 1 Step -1
For yoko = (tate Mod 2) + 1 To ookisa - tate + 1 Step 2
hen1 = 0: hen2 = 0: hen3 = 0
'隣と同じかどうか
If yoko > 1 Then If Cells(tate, yoko) <> Cells(tate, yoko - 1) Then hen1 = 1 '＼
If tate + yoko <ookisa Then If Cells(tate, yoko) <> Cells(tate, yoko + 1) Then hen2 = 1 '／
If tate > 1 Then If Cells(tate, yoko) <> Cells(tate - 1, yoko) Then hen3 = 1 '－
If tate = 1 Then If Cells(tate, yoko) = "*" Then hen3 = 1
'隣と違えば線を引く
For tonari = 1 To 6 'tonari再利用:円を六等分
For ido = -1 To 1 Step 2 'ido再利用
cc = Cos(tonari / 3 * 3.14)
ss = Sin(tonari / 3 * 3.14)
x1 = xcore + ((ookisa - tate) * cc + (yoko - 1) / 2! * ss * ido) * haba
y1 = ycore + ((ookisa - tate) * ss - (yoko - 1) / 2! * cc * ido) * haba
x2 = xcore + ((ookisa - tate + 1) * cc + (yoko - 2) / 2! * ss * ido) * haba
y2 = ycore + ((ookisa - tate + 1) * ss - (yoko - 2) / 2! * cc * ido) * haba
x3 = xcore + ((ookisa - tate + 1) * cc + yoko / 2! * ss * ido) * haba
y3 = ycore + ((ookisa - tate + 1) * ss - yoko / 2! * cc * ido) * haba
If hen1 Then
ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 41
Selection.ShapeRange.Line.Visible = msoTrue
End If
If hen2 Then
ActiveSheet.Shapes.AddLine(x1, y1, x3, y3).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 41
Selection.ShapeRange.Line.Visible = msoTrue
End If
If hen3 Then
ActiveSheet.Shapes.AddLine(x2, y2, x3, y3).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 41
Selection.ShapeRange.Line.Visible = msoTrue
End If
Next ido
Next tonari
Next yoko
Next tate
Range("A1").Select
End Sub
私が子供の頃にスピログラフという玩具がありました。今もあるんでしょうか。ぎざぎざのついた枠の中で鉛筆を差し込む穴のあいた歯車を回転させて美しい模様を作るもの。同じクラスの友達が持っていました。私も欲しかったので段ボールで作りました。段ボールは摩擦が大きいのでぎざぎざがなくても適当にひっかかってくれて、それなりに遊べました。そして、すぐに飽きました。買ってもらわなくてよかったです。
Windowsで動くN88BASICがあって、それでスピログラフのプログラムを作ったのは2003年10月でした。その後N88BASICの無い環境でスピログラフをやってみたくてExcelで作りました。線を引くには前回決めた点の位置を記憶しないといけないというのが面倒なので、ひたすら点を打ちたい。しかしExcelのVBAはpsetみたいな命令がありません。いまどきの画面で点を打ったって小さすぎて見えやしないのです。今どき画面上のひとつの点をピクセルというんですか。昔でいうドット。ノスタルジックに粗く四角い点をいっぱい打つために、セルをドットとして使いました。
歯車の上の点の位置や回転数などを乱数で決めるので毎回違う模様ができます。もうちょっと体裁よく作れそうなものですが、ただてっとりばやくスピログラフをやってみたかっただけ。あれから何年か経つので作った本人にさえプログラムが何やっているかさっと見ただけじゃわかりません。
Sub スピログラフ()
' 注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。また、出来上がった画面を保存する場合は別のブックにコピーしたものをお使いください。
Cells.Select
Selection.Delete Shift:=xlUp
Selection.ColumnWidth = 0.23
Selection.RowHeight = 3
Randomize
r = Rnd * 128
p = Rnd * r
s = Rnd * 20
For i = 1 To 360 * s
x = Sin(i / 180 * 3.14) * (128 - r) + Cos((i * (128 / r - 1)) / 180 * 3.14) * p
y = Cos(i / 180 * 3.14) * (128 - r) + Sin((i * (128 / r - 1)) / 180 * 3.14) * p
Cells(y + 128, x + 128).Select
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next i
End Sub
Windowsで動くN88BASICがあって、それでスピログラフのプログラムを作ったのは2003年10月でした。その後N88BASICの無い環境でスピログラフをやってみたくてExcelで作りました。線を引くには前回決めた点の位置を記憶しないといけないというのが面倒なので、ひたすら点を打ちたい。しかしExcelのVBAはpsetみたいな命令がありません。いまどきの画面で点を打ったって小さすぎて見えやしないのです。今どき画面上のひとつの点をピクセルというんですか。昔でいうドット。ノスタルジックに粗く四角い点をいっぱい打つために、セルをドットとして使いました。
歯車の上の点の位置や回転数などを乱数で決めるので毎回違う模様ができます。もうちょっと体裁よく作れそうなものですが、ただてっとりばやくスピログラフをやってみたかっただけ。あれから何年か経つので作った本人にさえプログラムが何やっているかさっと見ただけじゃわかりません。
Sub スピログラフ()
' 注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。また、出来上がった画面を保存する場合は別のブックにコピーしたものをお使いください。
Cells.Select
Selection.Delete Shift:=xlUp
Selection.ColumnWidth = 0.23
Selection.RowHeight = 3
Randomize
r = Rnd * 128
p = Rnd * r
s = Rnd * 20
For i = 1 To 360 * s
x = Sin(i / 180 * 3.14) * (128 - r) + Cos((i * (128 / r - 1)) / 180 * 3.14) * p
y = Cos(i / 180 * 3.14) * (128 - r) + Sin((i * (128 / r - 1)) / 180 * 3.14) * p
Cells(y + 128, x + 128).Select
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next i
End Sub
何年もの間頭にうかんではそのままにしていたExcelマクロの万華鏡をとうとう作ったのは2005年の春でした。
長さ１対√２の２枚の鏡を45度に合わせた四角い万華鏡。色のついたセルが移動していきます。
いずれ微妙な色を使うように改造しようと思っていたのですが、この動きの遅さでは今のところそうする気になっていません。
Windowsの場合はアニメーションとして楽しめます。Macでは処理が全部終わるまで少々長い時間画面が変わらないので、席を立って何かやっている間に実行するのがいいようです。
Sub kakeido()
' 2005.4.2 箱田 桂子
'注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。また、出来上がった画面を保存する場合は別のブックにコピーしたものをお使いください。
'発現の割合
iro1 = 7 '同色
iro2 = 0 'とりあえず未使用
iro3 = 1 'ランダム色
ookisa = 20
Cells.Select
Selection.ColumnWidth = 1 '実行中画面がscrollする場合は"1"を".5"にでも
Selection.RowHeight = 10 ' 同上 "10"を"5"にでもしてみてください
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
Columns("a:j").Select
Selection.EntireColumn.Hidden = True
'開始画面 hajimeの値
' 0:現在の状態 1:まっくろ 2:まっしろ 0<hajime<56
hajime = 1
If hajime Then
For i = 1 To ookisa
For j = 1 To i
Cells(i, j) = hajime
Next j
Next i
End If
Randomize
For kaisuu = 1 To 20
'移動----------
muki = Int(Rnd * 2)
Range(Cells(1, 1 + muki), Cells(ookisa - 1 + muki, ookisa)).Select
Selection.Cut
Cells(2 - muki, 1).Select
ActiveSheet.Paste
'色決定----------
For i = 1 To ookisa
If i = 1 Then muki = 1 Else If i = ookisa Then muki = 0 Else muki = Int(Rnd * 2)
iro = Int(Rnd * (iro1 + iro2 + iro3 )+ 1) '色の傾向を決定
If iro <= iro1 Then
'同色
Cells(i, i) = Cells(i + muki, i + muki - 1)
Else
If iro <= iro1 + iro2 Then
'未使用
Else
'ランダム色
Cells(i, i) = Int(Rnd * 57)
End If
End If
Next i
'色塗り----------
For i = 1 To ookisa
For j = 1 To i
For tate = -1 To 1 Step 2
For yoko = -1 To 1 Step 2
Cells(ookisa * 1.5 + (i - 1) * tate, ookisa * 2.5 + (j - 1) * yoko).Select
With Selection.Interior
.ColorIndex = Cells(i, j)
.Pattern = xlSolid
End With
Next yoko
Next tate
If i <> j Then
For tate = -1 To 1 Step 2
For yoko = -1 To 1 Step 2
Cells(ookisa * 1.5 + (j - 1) * tate, ookisa * 2.5 + (i - 1) * yoko).Select
With Selection.Interior
.ColorIndex = Cells(i, j)
.Pattern = xlSolid
End With
Next yoko
Next tate
End If
Next j
Next i
'------
Next kaisuu
Cells(1, 1).Select
End Sub
長さ１対√２の２枚の鏡を45度に合わせた四角い万華鏡。色のついたセルが移動していきます。
いずれ微妙な色を使うように改造しようと思っていたのですが、この動きの遅さでは今のところそうする気になっていません。
Windowsの場合はアニメーションとして楽しめます。Macでは処理が全部終わるまで少々長い時間画面が変わらないので、席を立って何かやっている間に実行するのがいいようです。
Sub kakeido()
' 2005.4.2 箱田 桂子
'注意
'作者はこのマクロの実行によって生じる一切について保障しませんのでご了承ください。
'安全の為マクロ実行後のブックの終了の際は保存しないでください。また、出来上がった画面を保存する場合は別のブックにコピーしたものをお使いください。
'発現の割合
iro1 = 7 '同色
iro2 = 0 'とりあえず未使用
iro3 = 1 'ランダム色
ookisa = 20
Cells.Select
Selection.ColumnWidth = 1 '実行中画面がscrollする場合は"1"を".5"にでも
Selection.RowHeight = 10 ' 同上 "10"を"5"にでもしてみてください
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
Columns("a:j").Select
Selection.EntireColumn.Hidden = True
'開始画面 hajimeの値
' 0:現在の状態 1:まっくろ 2:まっしろ 0<hajime<56
hajime = 1
If hajime Then
For i = 1 To ookisa
For j = 1 To i
Cells(i, j) = hajime
Next j
Next i
End If
Randomize
For kaisuu = 1 To 20
'移動----------
muki = Int(Rnd * 2)
Range(Cells(1, 1 + muki), Cells(ookisa - 1 + muki, ookisa)).Select
Selection.Cut
Cells(2 - muki, 1).Select
ActiveSheet.Paste
'色決定----------
For i = 1 To ookisa
If i = 1 Then muki = 1 Else If i = ookisa Then muki = 0 Else muki = Int(Rnd * 2)
iro = Int(Rnd * (iro1 + iro2 + iro3 )+ 1) '色の傾向を決定
If iro <= iro1 Then
'同色
Cells(i, i) = Cells(i + muki, i + muki - 1)
Else
If iro <= iro1 + iro2 Then
'未使用
Else
'ランダム色
Cells(i, i) = Int(Rnd * 57)
End If
End If
Next i
'色塗り----------
For i = 1 To ookisa
For j = 1 To i
For tate = -1 To 1 Step 2
For yoko = -1 To 1 Step 2
Cells(ookisa * 1.5 + (i - 1) * tate, ookisa * 2.5 + (j - 1) * yoko).Select
With Selection.Interior
.ColorIndex = Cells(i, j)
.Pattern = xlSolid
End With
Next yoko
Next tate
If i <> j Then
For tate = -1 To 1 Step 2
For yoko = -1 To 1 Step 2
Cells(ookisa * 1.5 + (j - 1) * tate, ookisa * 2.5 + (i - 1) * yoko).Select
With Selection.Interior
.ColorIndex = Cells(i, j)
.Pattern = xlSolid
End With
Next yoko
Next tate
End If
Next j
Next i
'------
Next kaisuu
Cells(1, 1).Select
End Sub