Excel也能玩糖果消消乐?

可以告诉你:当然可以!

Excel使用VBA编程,不仅可以轻松搭建糖果消消乐游戏,还有高分记录,撤销上一步等功能。不信,往下看:

打开Excel表格加载游戏,Go!

vba区域空格随机填充(ExcelVBAExcel也能玩糖果消消乐)(1)

捕获7

关于游戏

vba区域空格随机填充(ExcelVBAExcel也能玩糖果消消乐)(2)

捕获2

开始游戏

vba区域空格随机填充(ExcelVBAExcel也能玩糖果消消乐)(3)

捕获1

游戏进行中

vba区域空格随机填充(ExcelVBAExcel也能玩糖果消消乐)(4)

捕获5

撤销上一步

vba区域空格随机填充(ExcelVBAExcel也能玩糖果消消乐)(5)

捕获4

分数排名

vba区域空格随机填充(ExcelVBAExcel也能玩糖果消消乐)(6)

捕获6

界面编辑状态

vba区域空格随机填充(ExcelVBAExcel也能玩糖果消消乐)(7)

捕获8

快来下载Excel文件,一探究竟吧!

链接:https:///s/14xFs9L0s1n1p4ldixqc5jQ

提取码:9oq0

欢迎关注:Python编程与Office办公自动化

部分代码:

Private Sub m_BuildBallBoard() Dim intRow As Integer Dim intCol As Integer Dim strName As String Dim labTemp As MSForms.Label Dim strUseName As String Dim sngTop As Single Dim sngLeft As Single sngTop = labBackdrop.Top For intRow = 0 To CUBEGAME_HEIGHT sngLeft = 0 For intCol = 0 To CUBEGAME_WIDTH strName = CUBEGAME_PREFIX & Format$(intRow, "00") & Format$(intCol, "00") Set labTemp = Controls(strName) labTemp.Move sngLeft, sngTop, CUBEGAME_MARKERSIZE, CUBEGAME_MARKERSIZE strUseName = "labCube" & m_intBoard(intRow, intCol) With Controls(strUseName) labTemp.Tag = strUseName labTemp.Picture = .Picture labTemp.BackColor = QBColor(15) labTemp.BackStyle = .BackStyle labTemp.SpecialEffect = .SpecialEffect End With sngLeft = sngLeft CUBEGAME_MARKERSIZE Next sngTop = sngTop CUBEGAME_MARKERSIZE Next For intRow = 0 To CUBEGAME_HEIGHT For intCol = 0 To CUBEGAME_WIDTH strName = "labMarker_" & Format$(intRow, "00") & Format$(intCol, "00") Controls(strName).Visible = True Next Next labMask.ZOrder End Sub '-------------------------------------------------------- Private Function m_GameOver() As Boolean ' ' 测试剩余的可消糖果数测算下一步移动 ' 如果还可以移动则继续 ' 如果不能移动则 game over ' Dim intRow As Integer Dim intCol As Integer Dim lngCount As Long For intCol = 0 To CUBEGAME_WIDTH For intRow = CUBEGAME_HEIGHT To 0 Step -1 If m_intBoard(intRow, intCol) > 0 Then lngCount = 0 m_Connection intRow, intCol, m_intBoard(intRow, intCol), lngCount If lngCount > 1 Then m_GameOver = False Exit Function End If m_ResetSelection End If Next Next m_GameOver = True End Function

,