VBA西北人摇色子模拟

主要模拟以下场景：
庄稼：3个不知道
对家：揭开
看以下庄稼赢的概率

Option Explicit

Sub 再来一把_Click()
    '随机生成点数
    Dim tmp(6) As Variant
    
    tmp(0) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("B3").Formula = "=UNICHAR(" & (tmp(0) + 9855) & ")"
    
    tmp(1) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("B4").Formula = "=UNICHAR(" & (tmp(1) + 9855) & ")"
    
    tmp(2) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("B5").Formula = "=UNICHAR(" & (tmp(2) + 9855) & ")"
    
    tmp(3) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("D3").Formula = "=UNICHAR(" & (tmp(3) + 9855) & ")"
    
    tmp(4) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("D4").Formula = "=UNICHAR(" & (tmp(4) + 9855) & ")"
    
    tmp(5) = Application.WorksheetFunction.RandBetween(1, 6)
    Worksheets("sheet1").Range("D5").Formula = "=UNICHAR(" & (tmp(5) + 9855) & ")"
    
    '排序,从小到到
    Dim i, j, t As Integer
    For i = 0 To 5
        For j = 0 To 5
            If tmp(i) > tmp(j) Then
                t = tmp(i)
                tmp(i) = tmp(j)
                tmp(j) = t
            End If
        Next
    Next
    
    'Worksheets("sheet1").Range("K2:P2") = tmp
    
    Dim h1 As Integer
    h1 = 0
    For i = 5 To 0 Step -1
        If tmp(i) = 1 Then
            h1 = h1 + 1
        End If
    Next
        
    If h1 >= 2 Then
        Worksheets("sheet1").Range("B6") = "胜"
        Worksheets("sheet1").Range("D6") = "负"
    ElseIf h1 = 1 Then
        If (tmp(5) = tmp(4) Or tmp(4) = tmp(3) Or tmp(3) = tmp(2) Or tmp(2) = tmp(1)) Then
            Worksheets("sheet1").Range("B6") = "胜"
            Worksheets("sheet1").Range("D6") = "负"
        Else
            Worksheets("sheet1").Range("B6") = "负"
            Worksheets("sheet1").Range("D6") = "胜"
        End If
    Else
        If (tmp(5) = tmp(4) And tmp(4) = tmp(3)) Or (tmp(4) = tmp(3) And tmp(3) = tmp(2)) Or (tmp(3) = tmp(2) And tmp(2) = tmp(1)) Or (tmp(2) = tmp(1) And tmp(1) = tmp(0)) Then
            Worksheets("sheet1").Range("B6") = "胜"
            Worksheets("sheet1").Range("D6") = "负"
        Else
            Worksheets("sheet1").Range("B6") = "负"
            Worksheets("sheet1").Range("D6") = "胜"
        End If
    End If
        
    If Worksheets("sheet1").Range("B6") = "胜" Then
        Worksheets("sheet1").Range("B7") = Worksheets("sheet1").Range("B7") + 1
    Else
        Worksheets("sheet1").Range("D7") = Worksheets("sheet1").Range("D7") + 1
    End If
    
    'Worksheets("sheet1").Range("B6") = "胜"
    'Worksheets("sheet1").Range("D6") = "负"
End Sub
Sub 重置_Click()
    Worksheets("sheet1").Range("B6") = ""
    Worksheets("sheet1").Range("D6") = ""
    
    Worksheets("sheet1").Range("B7") = 0
    Worksheets("sheet1").Range("D7") = 0
    
End Sub

文件下载：摇色子.zip

阅读全文

2021-10-26 herokay 0 条评论

Visual Basic for Applications

VBA对话框批量添加按钮

说明：这篇不是原创内容，来自ExcelHome。时间长了也忘了具体网址了，这里摘录下来方面以后查找。

1.插入一个类模块，命名为MyCla，代码如下：

Public WithEvents Butt As MSForms.CommandButton
Private Sub Butt_Click()
    Dim x, y As Integer  
    strs = Split(Butt.Tag, "|")
    x = strs(0)
    y = strs(1)
End Sub

2.插入一个用户窗体UserForm1，代码如下：

Private Sub UserForm_Initialize()
    Dim i, j As Integer
    '画按钮，默认隐藏
    For i = 0 To MAPHEIGHT - 1 '行
        For j = 0 To MAPWIDTH - 1 '列
            Set buttons(i, j).Butt = UserForm1.Controls.Add("Forms.Commandbutton.1")
            With buttons(i, j).Butt
                .Caption = ""
                .Height = 18
                .Width = 18
                .Tag = i & "|" & j
                .PicturePosition = 12
                .Visible = False
                '.Caption = i & j
                If i = 0 Then
                    .Top = 10
                Else
                    .Top = buttons(i - 1, j).Butt.Top + 18
                End If
                If j = 0 Then
                    .Left = 150
                Else
                    .Left = buttons(i, j - 1).Butt.Left + 18
                End If
            End With
        Next
    Next
End Sub

效果图：

阅读全文

2019-03-25 herokay 0 条评论

Visual Basic for Applications

VBA入门基础（二）

之前提了一下用VBA做个推箱子游戏，当然这个纯属是拿来练手做教程用的，如果真的用vba来做游戏估计你让你搞到吐，Excel真心不合适做游戏！

一、准备工作（开启Excel宏支持）

说明：因需要通过Excel宏实现相应功能，所以使用前必须确保宏命令可以正常执行。本次通过Excel 2016演示宏命令启动，其他版本office基本相同，可参考执行。

1.启动Excel 2016，打开文件菜单

2.点击选项

3.点击信任中心，打开信任中心设置(T)...

4.点击宏设置，将宏设置选择为启用所有宏(不推荐：可能会运行有潜在危险的代码)(E)。（注意：此处选择为禁用所有宏，并发出通知(D)也可以，在首次启动是手动选择运行宏即可）

二、基本概念

概念解释是根据个人理解解释的，更准确的表示请自行找度娘

Workbook 工作簿

一个打开的Excel相当于一个Workbook，当前workbook可以用ThisWorkBook表示，或者Workbooks（"名称"）。

worksheet 工作表

每个打开的workbook西方看到的就是sheet，一个workbook至少有一个worksheet。

工作表可以用名称表示，也可以用序号，比如worksheets（“名称”）或worksheet（1）

Range 区域

可以是一个单元个，多个连续单元格或不连续单元格，如Range（“A1”），Range（“A:Z)

Cells 单元格

Cells是指单元格和Range不同的之处在于Cells是用的参数，Cells（行，列）。比如A1单元格表示为Cells（1，1）。

sub，定义一个过程，可以直接运行

比如：

sub test（）
    Thisworkbook.Worksheets(1).Range("A1")="A1"
end sub

function，定义一个函数，只能被调用不能直接运行

function test1()
    ThisWorkbook.Worksheets(1).cells(1,1)="A1"
end function

三、开始使用vba。

启动Excel，打开或新建一个Excel文件，按Alt+F11，在左侧工程面板点右键，插入-模块

点击模块1，在下方属性区域可以修改名称。

四，注意事项

1.标点符号请使用英文输入法下的标点符号
2.尽可能给代码添加注释，这个好习惯在代码很长的项目中会让你深有感受
3.vba代码不区分大小写，比如str和Str是一样的，不过为了方便维护，建议统一风格
4.vba默认情况下变量不用声明即可使用，例如：

str = “heollo VBA”
msgbox（str）

如果项目比较大，你会为此付出惨痛代价，比较单词输入错误了，系统不会提示任何错误。建议开启变量要求声明功能。
点击工具，选项，勾选要求变量声明。

开启该功能后，新插入的模块会多出来一句Option Explicit,再运行声明的代码会提示出错。需要改一下：

Option Explicit

Sub test5()
Dim str As String
str = "Hello VBA!"
MsgBox (str)
End Sub

或者

Option Explicit

Sub test5()
Dim str  = "Hello VBA!"
MsgBox (str)
End Sub

阅读全文

2019-03-16 herokay 0 条评论

Visual Basic for Applications

用VBA做搬箱子游戏

功能很简单，点击开始游戏弹出关卡选择对话框，选择好关卡即可开始游戏。

点击设计地图功能打开地图设计器，在这可以新增和编辑关卡。

关卡最大容量30*25

功能还在完善，完善后发制作详情

阅读全文

2019-03-14 herokay 0 条评论

Visual Basic for Applications

给office添加功能按钮

这篇文章秉承拿来主义思想，学会复制粘贴使用即可，不做理论上的讲解，想深入学习的同学自行百度Ribbon，XML相关知识。
这篇文章主要介绍一下怎样给office菜单功能添加自定义的功能。在起名字的时候纠结了一下，本想直接写成《Microsoft Ribbon菜单功能区添加自定功能》，怕大家看到E问头皮发麻，就写了个很土但是能看懂的名字。