Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。Word VBAも始めました。

原子の構造と電子配置③ 40粒で原子核ぽいのを描いてみた

つづきです
chemiphys.hateblo.jp

やると決めたからにはやれるところまでやろうと,思っています。
電子を回す方は,それなりにできたわけですので,とにかくまずは原子核!

chemiphys.hateblo.jp
こちらが電子を回しているほうです。

いろいろ出かけたりしているうちに,thomさんから言及していただいていました。
thom.hateblo.jp

いつも,貴重な知識や指針をもらえますが,今回も後押しいただけて,とてもありがたい。
とてもいい動画もたくさんあるんですね。自分で考えることも大事ですが,優れたものを見るためにもたくさん見ないとです。

ちなみに,教材に使えるかなーということで,ディスカバリーチャンネルナショナルジオグラフィックをよく録画してみています。
いろんな本もですが,BSを視聴するためにとか,理科やVBAにけっこうお金を費やしているなぁ。学生時代より勉強している。。(;´▽`A``

ビックバンの映像とか,どうやって元素が作られたのか,などとても楽しい映像がたくさんあります。

元素といえば化学なのに,元素のでき方は化学では学びません(゚▽゚*)

そこは地学のほうが多くの知見をもらえるんです。高校で学ぶ知識なんてほんの一部。
特に様々なことが昔よりたくさんわかった現在,NHKの多くの番組や,先ほどのチャンネルで作られた映像は驚きに満ちていて,言葉では表せないのでそちらを見せることもあります。

ですが,そんなことばっかりやってたら,仕事しろと怒られるので,自分でもできうるだけスムーズにきっかけとなるイメージを与えるべくガンバッテルトコデス。

さて,本題に戻します。

まだ細かいところをきちんとやっていませんが,進捗を提示するのも一つの意義を感じますし,途中のほうがコードがコンパクトです。

恥ずかしげもなく途中のを載せてみます。

f:id:chemiphys:20170129203312p:plain

黄色と青の粒が20個ずつあります。それっぽくなってきました(゚▽゚*)

こちらがコードになります。酷使しているのかな,強制終了をよくくらいますので,ご注意ください。

Option Explicit
Const PI = 3.1415

Sub Test()
Dim TargetSlide As Slide: Set TargetSlide = ActivePresentation.Slides(1)
Dim 粒子() As Shape, 粒子数 As Long
Dim StartX As Long, StartY As Long
Dim i As Long, j As Long
Dim dX As Long, dY As Long
Dim R As Long
StartX = 200: StartY = 200

粒子数 = 40
ReDim 粒子(粒子数)
i = 粒子数

Do
    Select Case i
        Case 1
            dX = 0: dY = 0
        Case 2 To 8
            R = 28
            dX = R * Cos(2 * PI / 7 * (i - 1))
            dY = R * Sin(2 * PI / 7 * (i - 1))
        Case 9 To 23
            R = 48
            dX = R * Cos(2 * PI / 15 * (i - 8))
            dY = R * Sin(2 * PI / 15 * (i - 8))
        Case 24 To 40
            R = 62
            dX = R * Cos(2 * PI / 17 * (i - 23))
            dY = R * Sin(2 * PI / 17 * (i - 23))
    End Select

    Set 粒子(i) = TargetSlide.Shapes.AddShape(msoShapeOval, StartX + dX, StartY + dY, 30, 30)
    粒子(i).Fill.ForeColor.RGB = IIf(i Mod 2 = 1, vbYellow, vbBlue)
    
    粒子(i).ThreeD.BevelBottomDepth = 15
    粒子(i).ThreeD.BevelBottomInset = 15
    粒子(i).ThreeD.BevelTopDepth = 15
    粒子(i).ThreeD.BevelTopInset = 15
    粒子(i).Line.Visible = msoFalse
    
    i = i - 1
Loop Until i = 0


End Sub

回転運動等で遊んでいた経験のおかげで,sin,cosと楽しく戯れたコードです。

40から逆に戻っていっているのは重なり順のためです。後に作った図のほうが前面にいくので逆順に作るとそれっぽくなる。

3Dを入れなければもう少し強制終了しないのかな。。ただ,3Dは入れたくなりますので,粒を作ったものを画像としてコピーさせていくような感じにつくれば,
パソコンに負担はかからないのかもしれない。。

とりあえず今は交互に色を変えているので,ランダムさをすこし取り入れてそれっぽさを増さないと。

思ったよりそれっぽくはなってきたので,すこしご機嫌です。