Excel Maniacs

ワード マクロ（Word VBA)でゲームを作成・・・(その３）

★遊び方　バラバラになったパネルを下図のように整列させて下さい。

１．マクロを有効にして下さい。モニター中央にゲーム画面が現れます

２．ブランクパネルに隣り合ったパネルをマウスでクリックすると２枚のパネルが入れ替わります。

15puzzleをダウンロード

15パズル(最終回)

１５パズルもいよいよ、最終回です。今回は

完成品をアップします。遊んでみてください。

くまぷー自身、三四郎は初心者なので

「なんだこりゃ？！」と思うようなところが多々あったのでは

ないかと思います。しかし、以前にも書きましたが

Super Play Rite　の作品を公開しているサイトは少ないながらも

存在しますが、コードの解説をしているサイトは

(ほとんど）存在しないように思います。ジャストシステム自身が

Super Play Riteの普及を放棄したように思える今、そこのところに

このサイトの存在理由があります。

これからも拙いながら、三四郎マクロを公開していきます。

コメントなど頂けたら、励みになりますのでよろしくお願いいたします。

sns15PUZZLE.lzhをダウンロード

15パズル(19)

!!１５パズル　by　くまぷー
!!2007/04/23
!!All Rights Reserved
!!教員のための三四郎活用術
!!http://kumapooh.typepad.jp/

Call Init
MsgBox("パネルをシャッフルします。")
Randomize(ThisTime())
%X=5
%Y=8
for %i = 1 To 3000

　　%DX = Int(Rand() * 3)-1
　  %DY = Int(Rand() * 3)-1
　　If Abs(%DX + %DY) = 1 Then
 
　　　　 If Cells(%Y+%DY, %X+%DX) = "" Then
   　　　　　　　continue for
  　　　　Else
   　　　　　　　Cells(%Y, %X) = Cells(%Y+%DY, %X+%DX)
   　　　　　　　Cells(%Y+%DY, %X+%DX) = ""
 
   　　　　　　　%Y = %Y+%DY
   　　　　　　　%X = %X+%DX
  　　　　End If
 
　　End if
next

MsgBox("新しいゲームを始めます。")

Do While %MyKey <> "{ESC}"
　　Set %MyRange = Range?
　　%MyKey=GetKey(2,0)

　　try
　　　　%Cnt =%MyRange.Cells.Count
　　Exception
　　Case "ConstraintError"
　　　　　MsgBox("Quit")
　　　　　stop
　　end try

　　If %Cnt = 1 Then
　　　　If Row(%MyRange) > 4 And Row(%MyRange)< 9 And \\
　　　　　　Col(%MyRange)>1 And Col(%MyRange)<6 Then
　　　　　  For %dy = -1 To 1
                      For %dx = -1 To 1
                             If Abs(%dy + %dx)=1 Then
                                  If Row(%MyRange)+%dy > 4 And Row(%MyRange)+%dy< 9 And \\
　　　　　                  　     Col(%MyRange)+%dx>1 And Col(%MyRange)+%dx<6 Then
             If Cells(Row(%MyRange)+%dy, Col(%MyRange)+%dx)="" Then
                 Cells(Row(%MyRange)+%dy, Col(%MyRange)+%dx)=\\
                 Cells(Row(%MyRange), Col(%MyRange))
              Cells(Row(%MyRange), Col(%MyRange))=""
                 End If
          End If
      End If
    Next
      Next
　　　　　　If IsGameOver Then
　　　　　　　　MsgBox("Very Good!!")
　　　　　　　　Stop
　　　　　　End If
　　　　End If
　　End If
Loop

Function IsGameOver() As Boolean
　　%i=1
　　IsGameOver=True
　　For %y = 5 To 8
　　　　　For %x = 2 To 5
　　　　　　　　If %i = 16 Then
　　　　　　　　　　%i = ""

　　　　　　　　End If
　　　　　　　　If Cells(%y, %x)<> %i Then
　　　　　　　　　　IsGameOver=False
　　　　　　　　End If
　　　　　　　　%i=%i+1
　　　　　Next
　　Next
End Function

Sub Init()
　　%i=1
　　For %y = 5 To 8
　　　　　For %x = 2 To 5
　　　　　　　　If %i = 16 Then
　　　　　　　　　　%i = ""
　　　　　　　
　　　　　　　　End If
　　　　　　　　Cells(%y, %x)=%i
　　　　　　　　%i=%i+1
　　　　　Next
　　Next

End Sub

注　\\は行継続文字

　　赤字のコードはESCキー押下でゲームを中止するためのもの。

　　青字のコードはエラー対策のためのもの。