admin 管理员组文章数量: 887016
2024年3月1日发(作者：如何自学编程入门视频)
Excel VBA编程 典型实例—拼图游戏
拼图游戏是深受大众喜欢的游戏之一。它通过将原始图片分成若干个小图片，并将这些图片的顺序打乱。这样，用户每次移动一个图片，直到将图片复原。
1．练习要点
设置单元格
编写代码
2．操作步骤
（1）启动Excel 2007，新建一个工作表。选择【开发工具】选项卡，单击其中的【插入】下拉按钮，执行【按钮】命令，将按钮插入到工作表中，此时弹出【指定宏】对话框，如图8-9所示。
绘制
图8-9 添加按钮
添加按钮时，为了不影响图片的显示，用户可以将按钮，放置在
（2）在【指定宏】对话框的“宏名”文本框中，输入“开始”。单击【新建】按钮，将弹出【代码】编辑窗口。编写代码如下：
提 示
“I13:J15”单元格上。
Public Sh1 As New Worksheet
Public mYxJh As New Collection
Public tptem As Shape
Public mPl(1 To 17) As String
Public cs As Integer
Sub 开始()
cs = 0
'对象变量赋值
Set Sh1 = Sheet1
'集合清空
Set mYxJh = Nothing
With Sh1
.Range("I23") = "<--单击右下角图片"
.Range("L23") = "Modify By 虫虫"
.Range("J9") = 0
.Range("L2") = "游戏规则"
.Range("L2").ndex = 3
.Range("L3") = "首先，单击“开始”按钮，然后右下角图片。"
End With
Updating = False '屏幕更新功能_关闭(加快速度)
mYxQk '调用清空过程
mYxFg '调用图片分割过程
mYxPl '调用图片排列过程
For sz = 1 To 16
mName = "tu" & sz
("tu" & sz).OnAction = "'Shape_Click """ & mName & """'" '给分割后的图片加入点击事件
Next
Updating = True '屏幕更新功能_打开
End Sub
Private Sub mYxQk() '清空界面
For Each ct In '删除全部图片
If Left(, 13) = "Button 1" Then
Else
End If
Next
With ture( + "", True, True, 530, 120, 160, 160)
.Name = "图片" '加入一张图片(必须为正方形)
.ShapeStyle = msoLineStylePreset1 '加入外框
End With
End Sub
Private Sub mYxFg() '分割图片
Dim r1 As Integer
Dim b1 As Integer
Dim xh As Integer
Set tptem = ("图片").Duplicate
With tptem '获得图片1:1的高度(必须为正方形)后删除
.ScaleWidth 1, True
.ScaleHeight 1, True
b1 = .Height
.Delete
End With
For i = 0 To 3 '以下为复制16张图片并分割
For j = 0 To 3
xh = xh + 1
Set tptem = ("图片").Duplicate
With tptem
.Name = "tu" + Trim(Str(xh))
.ScaleWidth 1, True
.ScaleHeight 1, True
End With
With eFormat
.CropLeft = b1 * j / 3.5
.CropTop = b1 * i / 3.5
.CropRight = b1 * (3 - j) / 3.5
.CropBottom = b1 * (3 - i) / 3.5
End With
tptem '把图片加入集合
Set tptem = Nothing '对象清空
Next
Next
End Sub
Private Sub mYxPl() '随机排列图片
Randomize ' 对随机数生成器做初始化的动作
For qk = 1 To 17 '数组清空
mPl(qk) = ""
Next
p1 = 15 '以下为随机排列图片
For xh = 1 To p1
k = Int((p1 * Rnd) + 1) ' 生成1-16之间的随机数值
For p2 = 1 To p1
If Val(Mid(mPl(p2), 3, 2)) = k Then
k = Int((p1 * Rnd) + 1) ' 生成1-16之间的随机数值
p2 = 0
End If
Next
With (k) '指定15张图片到指定位置
mPl(xh) = .Name
.Left = .Width * ((xh - 1) Mod 4)
.Top = .Height * (Int((xh - 1) / 4) Mod 4)
End With
Next
With (16) '指定第16张图片到指定位置
mPl(16) = .Name
.Left = .Width * 3
.Top = .Height * 3
End With
End Sub
Sub Shape_Click(ByVal SHname As String) '图片点击事件
On Error Resume Next '捕捉错误
Dim szXH As Integer
Dim szXHt As Integer
Dim tpXH As Integer
cs = cs + 1 '累计点击次数
tpXH = Val(Mid(SHname, 3, 2)) '获得该图片的序号
For q1 = 1 To 17 '遍历数组
If mPl(q1) = (tpXH).Name Then szXHt = q1 '获得该图片对应的数组的序号
If mPl(q1) = "" Then szXH = q1 '获得空数组(空格)的序号
Next
Select Case szXHt - szXH
Case -1 '图片右移
With (tpXH)
.Left = .Left + .Width
mPl(szXHt) = ""
mPl(szXH) = .Name
End With
Case 1 '图片左移
With (tpXH)
.Left = .Left - .Width
mPl(szXHt) = ""
mPl(szXH) = .Name
End With
Case -4 '图片下移
With (tpXH)
.Top = .Top + .Height
mPl(szXHt) = ""
mPl(szXH) = .Name
End With
Case 4 '图片上移
With (tpXH)
.Top = .Top - .Height
mPl(szXHt) = ""
mPl(szXH) = .Name
End With
End Select
With Sh1
.Range("I8") = "最高纪录"
.Range("K8") = "次"
.Range("I9") = "已点击了"
.Range("J9") = cs
.Range("K9") = "次"
End With
q2 = 1
Do While q2 <= 16 '判断是否完成该游戏
If mPl(q2) = (q2).Name Then
q2 = q2 + 1
If q2 = 17 Then
MsgBox "恭喜你,已成功完成!" + Chr(10) + "你共点击了" + Str(cs) + "次"
If ("J9") = 0 Then ("J9") = cs
If cs < ("J9") Then ("J9") = cs
End If
Else
Exit Do
End If
Loop
End Sub
（3）这样，单击该按钮，就可以进行拼图游戏。
版权声明：本文标题：Excel VBA编程 典型实例—拼图游戏 内容由网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：http://www.freenas.com.cn/jishu/1709282959h541932.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论