EXCEL 游戏.docx

EXCEL 游戏.docx

《EXCEL 游戏.docx》由会员分享，可在线阅读，更多相关《EXCEL 游戏.docx（17页珍藏版）》请在冰豆网上搜索。

EXCEL游戏

一：

纸牌游戏

启动Excel程序，依次点击工具栏中“工具/自定义”菜单，切换至“命令”标签页，选中左侧“类别”栏中的“工具”菜单，向下拖动右侧“命令”栏侧边滑块，找到带有纸牌图形的“自定义”选项（如图），将它拖至Excel工具栏中，点击“关闭”按钮将“自定义”对话框关闭。

现在，Excel工具栏中就多了一个纸牌按钮，点击该按钮，熟悉的纸牌游戏界面就出现在你面前了。

二：

MicroSoftExcel2000暗藏赛车游戏

1.开启Excel之后随便开一新文档,将它『另存成Web画面』,按下发布后再将“添加交互对象”打勾,将档案储存为car.htm（文件名可自取）。

2.在IE中开启car.htm，你应该会看到电子表格出现在网页中央，如图1：

图1

3.在这个工作表中，先用PageDown键移动工作表的矩形光标直至第2000行，注意只能用PageDown键，然后用Tab键横向向右移动光标直至WC列，也是只能用键操作，到此，所有的准备工作已经完毕，该是调出游戏的时候了。

4.同时按住Shift+Crtl+Alt然后点选左上方的Officelogo。

5.开始玩了,如图2：

图2

6.玩法提示:

玩游戏的时候，被你控制的是那一辆浅蓝色的汽车，操作的主要是四个箭头按键。

作用是：

左右箭头可以控制汽车的方向：

向上箭头可以加速，向下的箭头减速；如果汽车运行到了夜间，可用H键打开车灯。

绝对好玩！

三：

数字华容道

'先说个简单的。

大家玩过那个数字华容道吧，就是有N*N个格，有一格是空的，其他格是次序混乱的拼图或数字，游戏的目的就是利用这唯一的这个空格移动各块拼图把混乱的拼图（数字）恢复（顺序）。

这里我们小游戏的目的是要把1至15这15个次序混乱的数字恢复从1到15的顺序排列。

'打开Excel后打开代码编写器（Alt+F11），将如下代码写入模块中。

程序首先是初始化。

定义变量，选择4*4的空格，调整表格大小，改变单元格颜色（标示出游戏区域），然后是让1到15非重复随机分布到前15格空格中：

PublicConstPW="E"'本游戏由Excel吧bengdeng整理！

PublicRunningAsBoolean'用于判断游戏是否进行中，如果要中途退出或玩家需要重玩用此变量控制

PublicSRanAsRange'游戏左上单元格

PublicBRanAsRange'游戏空格单元格

PublicNAsInteger'游戏区域大小

PublicGRanAsRange'游戏区域，这里由N与SRan生成

PublicBsAsInteger'游戏步数

PublicSTimeAsDate'游戏开始时间

SubGameStar（）

DimiAsInteger

DimiiAsInteger

DimtempAsInteger

Dima（14）AsInteger

DimdownAsVbMsgBoxResult

'判断游戏是否在运行

IfRunningThen

down=MsgBox（"游戏正在进行！

是否重玩？

",vbYesNo,"提示-"&PW）

Ifdown=vbNoThenExitSub

EndIf

Running=True

N=4'设定游戏区域为4*4

SetSRan=Range（"E5"）'设定游戏开始单元格为E5

SetBRan=SRan.Offset（N-1,N-1）'设定游戏空单元格

SetGRan=Range（SRan,BRan）

'游戏区域（颜色）初始化，省略了单元格大小的调整，大家可以应该加入相应语句让游戏外观整齐

IfActiveSheet.ProtectContentsThenActiveSheet.UnprotectPassword:

=PW

GRan.ClearContents

GRan.Interior.ColorIndex=35

'随机数数组初始化，这里是编号0到编号14共15个数

Fori=0To（N*N-2）

a（i）=i+1

Nexti

'不重复随机分布各数

Fori=N*N-2To0Step-1

Randomize

ii=Int（Rnd*i）

temp=a（i）

a（i）=a（ii）

GRan.Item（i+1）=a（i）

a（ii）=temp

Nexti

Bs=0

STime=Now（）

ActiveSheet.ProtectPassword:

=PW

EndSub

'很明显，Excel的单元格是游戏的主角。

初始化后游戏开始，逻辑很简单：

玩家每单击一个单元格（产生Workbook中的SheetSelectionChange事件），游戏就判断这个格是否在游戏区域中，若是就判断上下左右4个方向是否有空格，如果有空格就把原单元格中的数传到空格中，原单元格清空（空格与原单元格交换），然后判断游戏是否结束（1到15顺序排序了？

），若还没有，什么都不做，等下一次单击事件发生。

PrivateSubWorkbook_SheetSelectionChange（ByValShAsObject,ByValTargetAsRange）

DimdownAsVbMsgBoxResult

DimiAsInteger

IfRunningThen

'所单击单元格是否就是空格

IfLen（ActiveCell）>0Then

'所单击单元格是否在游戏区域

IfNot（Application.Intersect（ActiveCell,GRan）IsNothing）Then

'所单击单元格上下左右是否有空格

If（（Abs（BRan.Column-ActiveCell.Column）<=1AndBRan.row=ActiveCell.row）Or（Abs（BRan.row-ActiveCell.row）<=1AndBRan.Column=ActiveCell.Column））Then

'单元格与空格交换

IfActiveSheet.ProtectContentsThenActiveSheet.UnprotectPassword:

=PW

BRan=ActiveCell

ActiveCell.ClearContents

SetBRan=ActiveCell

Bs=Bs+1

ActiveSheet.ProtectPassword:

=PW

'判断游戏是否结束?

i=1

DoWhile（i

i=i+1

Loop

Ifi=N*NThen

MsgBox"祝贺你！

你成功了！

"&vbCrLf&_

"一共用了"&Bs&"步！

"&vbCrLf&_

"一共用用时"&Format（Now-STime,"h:

m:

s"）,,PW

Running=False

EndIf

EndIf

EndIf

EndIf

Else

down=MsgBox（"游戏还未进行，是否开始？

",vbYesNo,"提示-"&PW）

Ifdown=vbYesThenGameStar

EndIf

EndSub

四：

跑跑卡丁车.xls

网上到处可下！

注:

打开Excel后,若不能玩,点菜单栏上的工具→宏→安全性,将安全级别设为低,便可以玩了

五：

贪吃蛇源码

首先要解决游戏显示的问题。

对我们来说，小游戏最好的平台是Excel的工作区，由于大小可调、颜色可填的单元格操作方便，我们完全可以把它们当像素来使用。

于是我们的贪吃蛇游戏就有了以单元格为基础的像素形式的显示方式了。

其次是游戏的控制方法。

在这里我摸索了好久，其中走了弯路不说，我最后的结论是在Excel中要实现按键事件的方法是引入窗体，然后在窗体中响应Keydown与Keypress事件。

这样的话，既可以快速响应还可以根据情况修改对应按键。

最后是游戏的定时问题。

所有的游戏事实上都是在一个时间大循环里面定时接收输入信息更新状态的程序，我们的小游戏都不例外。

老实说，我写这个游戏大部分的思考时间就浪费在如何实现游戏定时这里。

Excel的VBA中与定时有关的只有onTime函数，没有其他相关函数提供了，onTime函数可以实现某一事件在指定时间发生，但只能以秒为最小单位，对我们要在一秒内更新数十次信息的小游戏不适合，我们只能另找方法。

用过VB的人都知道VB控件中有个定时控件，用它来实现游戏定时是最好的，但在Excel中却没有，难道我要把VB中的定时控件移植到VBA中？

这也是个很值得研究的课题，但是我想到了另外的方法。

VB的程序员都知道要想VB程序发挥大作用一定离不开调用系统的API，于是我查看了系统相关API的帮助，发现系统API中实现相应功能的有settimer与killtimer函数，具体定义和用法大家可以参考相关帮助，但从字面大家都已经可以知道它们就是我们要找的东西了。

那么现在的问题就是如何在vba环境下调用系统API。

心想微软称vba就是office中的vb，那么在vba中调用系统API应该也与在VB中的一样。

一试，呵呵，果然非虚，这微软真不是盖的（后在msdn中发现msofficevba从2000版本开始支持调用系统API，大家可以拓展office应用了）。

就这样游戏输入、输出、逻辑定时的问题都解决了，我们的吃蛇游戏就仅剩下算法逻辑部分了。

我们的游戏逻辑是，游戏初始化后，启动定时器。

在每次定时循环中，程序分别实现蛇头移动与蛇尾移动。

首先是移动蛇头，游戏判断在移动方向上蛇头下一个的位置是否为空格，若是则把这位置的空格填上颜色（蛇头移动），蛇尾移动标志设为真；如果蛇头下一个位置不是空格（即有食物），则把这位置的空格填上颜色（蛇头移动）后把蛇尾移动标志设为假。

接着到蛇尾移动部分，若蛇尾移动标志为真则把蛇尾原所在单元格填回白色（蛇尾移动），并更新蛇尾位置；如果蛇尾移动标志为假，则什么都不做（蛇尾不动蛇头动，蛇身长了）。

对于整个游戏来说，效率的瓶颈在于像素操作（对单元格频繁填色）。

但从以上算法可以看到，在每次循环中程序只需处理蛇头及蛇尾所在单元格；如果贪吃蛇吃到食物，则只需要更新蛇头单元格。

每个时间循环里较少的数据处理量实现了游戏较快的响应速度，贪吃蛇游戏在Excel中实现也有了实际意义。

游戏还是以宏的形式实现。

大家新建一个宏，输入如下代码。

'熟悉VB的程序员知道首先是对调用系统API的声明

PublicDeclareFunctionSetTimerLib"user32"（ByValhwndAsLong,ByValnIDEventAsLong,ByValuElapseAsLong,ByVallpTimerFuncAsLong）AsLong

PublicDeclareFunctionKillTimerLib"user32"（ByValhwndAsLong,ByValnIDEventAsLong）AsLong

'定义数据结构

Typepos_

rowAsLong

colAsLong

EndType

PublictimersetAsLong'SetTimer函数的返回值，用以标记已存在的Timer，KillTimer以此为参数销毁所标记的Timer

PublicgamingAsBoolean

PublicpulsedAsBoolean

Publichead_movementAsLong'蛇头新移动方向标志，1、2、3、4代表右上左下

Publictail_movementAsLong'蛇尾移动方向标志，意义同上

Publicoldhead_movementAsLong'蛇头旧有移动方向标志

DimtailmoveAsBoolean'蛇尾移动标志

Dimorigin_sizeAsLong'贪吃蛇原始大小

PublicscoreAsLong

DimstepsAsLong

DimcleanAsBoolean

DimsthAspos_

DimheadrowAsLong'蛇头所在行位置

DimheadcolAsLong'蛇头所在列位置

DimtailrowAsLong'蛇尾所在行位置

DimtailcolAsLong'蛇尾所在列位置

DimstartposAspos_'贪吃蛇起始位置

DimcolorAsLong

ConstleftAsL5'游戏区域左边边界

ConstrightAsL30'游戏区域右边边界

ConsttopAsL3'游戏区域上边边界

ConstbottomAsL25'游戏区域下边边界

Functionmain（）'主函数

gaming=False

IfWorksheets.Count<2Then

ActiveWorkbook.Sheets.Addafter:

=Worksheets（Worksheets.Count）

ElseIf（MsgBox（"Doyouwanttorunitinanewblankworksheet?

",vbOKCancel,"?

?

?

?

?

"）=vbOK）Then

ActiveWorkbook.Sheets.Addafter:

=Worksheets（Worksheets.Count）

Else

Worksheets（Worksheets.Count）.Select

EndIf

LoadUserForm1'引入窗体

UserForm1.Show

EndFunction

Functiongame_initial（）'游戏初始化函数

'初始化游戏界面

color=5

IfNotgamingThen

Cells.ColumnWidth=1

Cells.RowHeight=10

Range（Cells（top,left）,Cells（top,right））.Interior.ColorIndex=1

Range（Cells（top+1,left）,Cells（bottom-1,left））.Interior.ColorIndex=1

Range（Cells（bottom,left）,Cells（bottom,right））.Interior.ColorIndex=1

Range（Cells（top+1,right）,Cells（bottom-1,right））.Interior.ColorIndex=1

Range（Cells（top+1,left+1）,Cells（bottom-1,right-1））.Font.ColorIndex=color

EndIf

'贪吃蛇初始化

origin_size=5

tail_movement=1

head_movement=1

oldhead_movement=head_movement

startpos.row=（top+bottom）\2'initializedas16

startpos.col=（left+right）\2'initailizedas20

pulsed=False

tailmove=True

headrow=startpos.row

headcol=startpos.col

tailrow=startpos.row

tailcol=startpos.col-origin_size+1

clean=True

steps=0

score=0

Fori=0Toorigin_size-1

Cells（startpos.row,startpos.col-i）.Interior.ColorIndex=color

Nexti

gaming=True

'游戏初始化结束

EndFunction

Subsnake_move（）

IfgamingThen

DimnextcolAsLong

DimnextrowAsLong

IfcleanThen

steps=steps+1

'贪吃蛇食物生成，这里食物的生成过程很简单，蛇每前进6步就生成一块食物

Ifsteps>=6Then

steps=0

Randomize

sth.row=Int（（bottom-top）*Rnd）+top+1

Randomize

sth.col=Int（（right-left）*Rnd）+left+1

DoWhilesth.row>=bottom

sth.row=sth.row-（bottom-top）+1

Loop

DoWhilesth.col>=right

sth.col=sth.col-（right-left）+1

Loop

Cells（sth.row,sth.col）="*"

clean=False

EndIf

EndIf

''''''蛇头移动部分

tailmove=True

Ifoldhead_movement<>head_movementThen

IfAbs（oldhead_movement-head_movement）<>2Then

oldhead_movement=head_movement

Cells（headrow,headcol）=head_movement'当方向改变时在蛇头当前单元格记下前进方向，待蛇尾运行至此时可以按正确方向前进。

本来应该用个数组记录，但我懒得再琢磨了。

EndIf

EndIf

SelectCaseoldhead_movement

Case1'right

nextrow=headrow

nextcol=headcol+1

Case2'up

nextcol=headcol

nextrow=headrow-1

Case3'left

nextrow=headrow

nextcol=headcol-1

Case4'down

nextcol=headcol

nextrow=headrow+1

EndSelect

'看是否超出游戏区域了。

Ifnextcol=leftThen

nextcol=right-1

ElseIfnextcol=rightThen

nextcol=left+1

EndIf

Ifnextrow=topThen

nextrow=bottom-1

ElseIfnextrow=bottomThen

nextrow=top+1

EndIf

IfCells（nextrow,nextcol）.Interior.ColorIndex=colorThen'蛇头碰到蛇身了，游戏结束

Callgame_over:

ExitSub

EndIf

IfCells（nextrow,nextcol）="*"Then

Callscore_

Cells（nextrow,nextcol）.ClearContents

EndIf

Cells（nextrow,nextcol）.Interior.ColorIndex=color

headrow=nextrow

headcol=nextcol

''''''蛇尾移动部分

IftailmoveThen

SelectCasetail_movement

Case1'right

nextrow=tailrow

nextcol=tailcol+1

Case2'up

nextrow=tailrow-1

nextcol=tailcol

Case3'left

nextrow=tailrow

nextcol=tailcol-1

Case4'down

nextcol=tailcol

nextrow=tailrow+1

EndSelect

Ifnextcol=leftThen

nextcol=right-1

ElseIfnextcol=rightThen

nextcol=left+1

EndIf

Ifnextrow=topThen

nextrow=bottom-1

ElseIfnextrow=bottomThen

nextrow=top+1

EndIf

IfCells（nextrow,nextcol）<>0Then

If（Asc（Cells（nextrow,nextcol））<>42）Then

tail_movement=Cells（nextrow,nextcol）

Cells（nextrow,nextcol）.ClearContents

EndIf

EndIf

Cells（tailrow,tailcol）.Interior.ColorIndex=0

tailrow=nextrow

tailcol=nextcol

EndIf

EndIf

EndSub

Functiongame_over（）

Iftimerset<>0Then

timerset=KillTimer（0,timerset）

pulsed=False

EndIf

IfMsgBox（"Gameover...temporarily.Tryagain?

",vbOKCancel,"?

?

?

?

?

"）=vbOKThen

Range（Cells（top+1,left+1）,Cells（bottom-1,right-1））.Interior.ColorIndex=0

Range（Cells（top+1,left+1）,Cells（bottom-1,right