トップに戻る

エクセルでグラフィックのお遊び

エクセルで、赤い丸と、緑の丸のアニメーションを、作ってみました。
どうなるかは、以下のJava アプレットで、表示されたようになります。
Javaが動作しない人は、
http://www.java.com/ja/
で、インストールしてください。
エクセルのvba で、ソースコードを書くと以下のようになります。
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMillsecounds As Integer)

Public Sub playcircle()
    Dim c1 As Shape
    Dim c2 As Shape

        Dim w As Integer
        Dim h As Integer

        Dim x As Integer
        Dim y As Integer
        Dim dx As Integer
        Dim dy As Integer


        Dim x1 As Integer
        Dim y1 As Integer
        Dim dx1 As Integer
        Dim dy1 As Integer

        Dim i As Long

        Application.Goto Range("a1")

        w = 670
        h = 350

        dx = 1
        dy = 1

        dx1 = 3
        dy1 = 3

        x = Rnd * w
        y = Rnd * h

       x1 = Rnd * w
       y1 = Rnd * h

       Set c1 = Sheet1.Shapes.AddShape(msoShapeOval, x, y, 50#, 50#)
             c1.Fill.ForeColor.RGB = RGB(255, 0, 0)

       Set c2 = Sheet1.Shapes.AddShape(msoShapeOval, x1, y1, 50#, 50#)
             c2.Fill.ForeColor.RGB = RGB(0, 255, 0)



       For i = 0 To 1000

             x = x + dx
               If x < 0 Then
                          x = 0
                         dx = dx * -1
               End If
               If x > w Then
                          x = w
                         dx = dx * -1
               End If

            y = y + dy
              If y < 0 Then
                        y = 0
                        dy = dy * -1
              End If
             If y > h Then
                       y = h
                      dy = dy * -1
              End If

          c1.Left = x
          c1.Top = y

          x1 = x1 + dx1
              If x1 < 0 Then
                          x1 = 0
                         dx1 = dx1 * -1
              End If
              If x1 > w Then
                          x1 = w
                         dx1 = dx1 * -1
              End If

          y1 = y1 + dy1
              If y1 < 0 Then
                         y1 = 0
                         dy1 = dy1 * -1
              End If
              If y1 > h Then
                         y1 = h
                         dy1 = dy1 * -1
              End If

         c2.Left = x1
         c2.Top = y1


          Sleep (20)
          DoEvents

       Next

       Sheet1.Shapes.SelectAll
       Selection.Delete

End Sub
上記コードを、エクセルの標準モジュールにコピーアンドペーストして、
マクロを実行すると、アプレットと同じ動作をします。