Excel-VBA提高(3): 设计自定义的操作/窗体

早期的计算机没有图形界面, 用户只能根据命令行的方式输入各种命令, 在 cmd 中输入代码可以实现.

可视化的操作界面, 会让操作程序和执行命令的过程变得更加简单.

控件 是搭建操作界面不可缺少的零件, excel 有两种类型的控件, 一个是 表单控件 , 另一个是 activeX控件

表单控件中有: 

1. 按钮 ;   2. 组合框(提供可选择的多个选项, 用户可以选择其中一个);  3. 复选框(可以多项选择)

4.数值调节钮(单击控件的箭头来选择数值);  5.列表框(显示多个选项的列表, 用户可以从中选择一个选项)

6.选项按钮(用于选择的控件, 通常几个选项按钮用组合框组合在一起使用,在一组中只能选择一个选项按钮)

7.分组框 (用于组合其他控件);  8.标签(输入和显示静态文本);   9. 滚动条(水平\垂直)

ActiveX 控件 11种+其他控件

(一)使用控件

添加一个组合框控件, .... 表单的, 不知道啥用

 添加activeX控件的选项按钮, 双击进入属性设置与 代码编写中, 属性中一般更改 (名称)  与 caption  设为xb1 表示 男

同样在插入一个 选项按钮, 命名为 xb2, 表示 女

Private Sub xb2_Click()
    If xb2.Value = True Then  ' 该按钮被选中了
        Range("A20").Value = "女"
        xb1.Value = False   ' 取消按钮的选中
    End If
End Sub

Private Sub xb1_Click()
    If xb1.Value = True Then
        Range("A20").Value = "男"
        xb2.Value = False
    End If
End Sub

完成后,  进入设计模式即可操作

    

 表单控件与 active 控件的差别在于 , 表单控件的用法单一, 只能在工作表中通过设置控件的格式或者指定宏来使用,  而 active 控件则拥有很多属性和事件, 不但可以在工作表中使用, 还可以在用户窗体中使用.

1. inputbox函数 创建一个可输入数据的对话框

 在模块中写代码

Sub inbox()
    Dim s As Variant
    s = InputBox("你想要在A1单元格输入什么?")
    Range("A1").Value = s
End Sub

运行后得到, 输入即可

还可以设置 对话框的标题, 默认的输入内容, 在桌面窗口显示的位置等

Sub inbox()
    Dim s As Variant
    s = InputBox(prompt:="你想要在A1单元格输入什么?", Title:="提示", _
    Default:="hahha", xpos:=2000, ypos:=2500)
    Range("A1").Value = s
End Sub

promp表示在对话框显示的信息, title 是对话框的名称

default 是输入的默认值, xpos 表示对话框左端与屏幕左端的距离, ypos 对话框顶端与屏幕顶端的距离,

上述参数的顺序可以打乱, 但是必须写参数名, 如果懒得写参数名, 那就必须按照循序来

Sub inbox()
    Dim s As Variant
    s = InputBox("你想要在A1单元格输入什么?", "提示", "hahha", 2000, 2500)
    Range("A1").Value = s
End Sub

 除了promp 参数以外, 其他参数都可以省略!

Sub inbox()
    Dim s As Variant
    s = InputBox("你想要在A1单元格输入什么?", , "hahha", 2000, 2500)
    Range("A1").Value = s
End Sub

再增加一个逗号 表示 省略了一个参数

 对比application.inputbox (inputbox 方法)

Sub inbox()
    Dim s As Variant
    s = Application.InputBox("prompt:=你想要在A1单元格输入什么?", Title:="提示", _
    Default:=123, Left:=2000, Top:=2500, Type:=1)
    Range("A1").Value = s
End Sub

type 是啥?

0 -->公式, 1-->数字, 2-->文本, 4-->逻辑值, 8-->单元格引用 (range对象), 16-->错误值 n/a, 64-->数值数组

 上述代码中,如果输入非数字 会出错!

Sub inbox()
    Dim r As Range
    On Error GoTo cancel
    Set r = Application.InputBox("prompt:=请选择需要输入的单元格区域", Type:=8)
    r.Value = 123 ' 在所选单元格中输入123
cancel:
End Sub

运行后, 用鼠标去选择单元格区域, 得到

     

上述中 如何指定输入的既可以是文本也可以是数字? 

 Type:=1 + 2

 这也是为什么type的值是 1 2 4 8 ... 这样不连续的设置了  相当巧妙!

 2.msgbox 

之前常用到msgbox, 它的参数设置是怎么样的呢?

Sub msg()
    MsgBox prompt:="你在学习", Buttons:=vbOKOnly + vbInformation, Title:="提示"
End Sub

得到

buttons 的设置: 

vbokonly : 只显示[确定]按钮

vbonlycancel : 确定+取消

....还有很多不介绍了...

 对话框中的蓝色图标这个也是在buttons 中更改: 

vbinformation : 通知信息

vbexclamation: 警告信息

3. findfile方法显示 [打开] 对话框

application.findfile 可以显示[打开] 对话框, 在对话框中选择并打开某个文件

Sub openfile()
    If Application.FindFile = True Then
    MsgBox "你选择的文件已经打开"
    Else
    MsgBox "你选择了取消, 文件没打开"
    End If
    
End Sub

运行 出现文件打开的对话框:

类似的, 有getopenfilename 方法显示[打开] 对话框 , 其中可以

application.getopenfilename(filefilter:="图片文件,  *.JPG")

限定对话框中显示的JPG类型的文件

Sub openfile()
    Dim fil As Variant
    fil = Application.GetOpenFilename(filefilter:="图片文件,  *.JPG")
 End Sub

 限定多种文件类型, 用; 隔开

Sub openfile()
    Dim fil As Variant
    fil = Application.GetOpenFilename(filefilter:="excel文件,*.xlsx;*.xlsm;*.xls")
    End Sub

 不同类型文档指定, 注意在一个" " 内, 用, 分开  这行代码用 _ 换行出错, 怎么回事???

Sub openfile()
    Dim fil As Variant
    fil = Application.GetOpenFilename(filefilter:="excel文件,*.xlsx;*.xlsm;*.xls, word文档,*.doc; *.docx")
    End Sub

 

 (二) 使用窗体设计交互界面

VBE中 右键 插入 窗体 默认名称叫做userform1

在窗体中, 可以自由的添加控件, 通过为这些控件编写代码, 就可以实现交互界面

 窗体的属性中, 名称 caption 都可以更改,( 名称是 控件名称(写代码要用), caption 是显示的文本,我们可以看得到的)

 

用工具箱 添加控件 默认工具箱会自动浮在VBE中,

 1, 插入文本框A

   

接着再进行添加,  两个文本框+ 1个复合框   ,性别对应的是复合框 

姓名 性别 出生年月 都是普通的标签 ( 可以复制后修改caption )

确定 退出 分别是命令按钮, 名称分别是是cmdok  cmdexit 

 接着, 显示操作设计好的窗体

1. 手动显示 ; 运行

2. 在程序中用代码显示窗体(加载+显示)

Sub showform()
    Load UserForm1  ' load 窗体名称
    UserForm1.Show
End Sub

设置窗体的显示位置

Sub showform()
'Load UserForm1   '没有也可以, 会自动加载的
    With UserForm1
        .startupposition = 0 ' 初次显示的位置由用户定义
        .Top = 100
        .Left = 200
        .Show
    End With
    
End Sub

这些属性在窗体的属性栏中也可以设置

 此时这个窗体还不能实现任何功能, 如何为窗体的控件设置功能?

首先对性别sex 这个复合框 设置列表, 用到initialize

Private Sub UserForm_Initialize()
    sex.List = Array("male", "female")
End Sub

1. [确定]按钮添加事件过程

Private Sub cmdok_Click()
    Dim xrow As Long  ' 用来保存数据的行号
    xrow = Range("A1").CurrentRegion.Rows.Count + 1 ' 空行号
    Cells(xrow, "A").Value = name1.Value  ' 将窗体中写入的数据写入工作表
    Cells(xrow, "B").Value = sex.Value
    Cells(xrow, "C").Value = birth.Value
    name1.Value = "" ' 清除窗体的数据, 等待下次输入
    sex.Value = ""
    birth.Value = ""
End Sub

上述两个都写在一起的,  右击 userform , 查看代码就可以进去 

这就实现了信息录入

例 . 制作简单的登陆窗体 ,只有权限才可以进入

设置窗体名称为denglu, 在属性中还可以更改窗体的背景, 可插入图片

   

 接着, 设置初始用户名和密码  : 在excel窗口中, 功能区--> 公式-->定义名称-->新建名称对话框

定义两个名称

1.username   =user      ,  2. useword   = 1234

这个什么用? ? 保存用户名与密码用于和真是输入的进行比较

一般的excel 的定义名称用于 给一个区域A1: C100定义一个名字(yuqu)

那么在求sum(A1: C100) =sum (yuqu)

为[确定]按钮设置代码, 该按钮用来核实输入的用户名和密码, 若正确则显示excel 工作界面,

Private Sub cmdok_Click()
    Application.ScreenUpdating = False ' 关闭屏幕更新
    Static i As Integer  ' 记录用户名或者密码输出的次数
    ' 判别用户名 密码是否正确
    If CStr(user.Value) = Right(Names("username").RefersTo, _
        Len(Names("username").RefersTo) - 1) _
        And CStr(psd.Value) = Right(Names("userword").RefersTo, _
        Len(Names("userword").RefersTo) - 1) Then
        Unload Me 'me表示代码所在的窗体, 关闭窗体
        Application.Visible = True
    Else
        i = i + 1
        If i = 3 Then
            MsgBox "输入次数已经到达上限, 你无权打开excel"
            ThisWorkbook.Close savechanges:=False ' 关闭当前工作簿, 不保存修改
        Else
            MsgBox "输入错误, 你还有" & (3 - i) & "次机会"
            user.Value = "" ' 情况文本框的中的用户名 密码
            psd.Value = ""
        End If
    End If
    Application.ScreenUpdating = True ' 关闭屏幕更新
End Sub

选择名称username，在引用位置 文本框中显示的内容，就是RefersTo 

Sub test()
    MsgBox Names("username").RefersTo
End Sub

Sub test()
    MsgBox Names("userword").RefersTo
End Sub

得到: 等号是有的!

       

 因此上述判断语句不能写成

    If CStr(user.Value) = Names("username").RefersTo _
        And CStr(psd.Value) = Names("userword").RefersTo Then

 接着, 在thisbookwork 中设置如下: 

Private Sub Workbook_Open()
    apllication.Visible = False ' 隐藏excel程序界面
    denglu.Show ' 显示登陆窗口
End Sub

 

 为[退出]按钮增加代码  取消登陆,即放弃打开工作簿

Private Sub cmdexit_Click()
    Unload Me
    ThisWorkbook.Close savechanges:=False ' 关闭当前工作簿, 不保存修改
End Sub

为[更改用户名] 添加代码  实际上就是更改 名称 "username" 中保存的数据, 

双击[更改用户名] 按钮, 调出 代码框 : 

Private Sub changeuser_Click()
    Dim old As String, new1 As String, new2 As String
    old = InputBox("请输入原用户名:")
    If old <> Right(Names("username").RefersTo, _
            Len(Names("username").RefersTo) - 1) Then
        MsgBox "原用户名有误, 不能修改"
        Exit Sub
    End If
    
    new1 = InputBox("请输入新用户名:")
    If new1 = "" Then
        MsgBox "不能输入为空, 无法修改"
        Exit Sub
    End If
    
    new2 = InputBox("请再次输入新用户名:")
    If new1 = new2 Then ' 两次输入的一样
        Names("username").RefersTo = "=" & new1
        ThisWorkbook.Save
        MsgBox "用户名修改成功"
    Else
        MsgBox "两次输入不一致, 修改未完成"
    End If
    
End Sub

类似的, 为[更改密码] 按钮增加代码

Private Sub changepsd_Click()
    Dim old As String, new1 As String, new2 As String
    old = InputBox("请输入原密码")
    If old <> Right(Names("userword").RefersTo, _
            Len(Names("userword").RefersTo) - 1) Then
        MsgBox "原密码有误, 不能修改"
        Exit Sub
    End If
    
    new1 = InputBox("请输入新密码:")
    If new1 = "" Then
        MsgBox "不能输入为空, 无法修改"
        Exit Sub
    End If
    
    new2 = InputBox("请再次输入新密码:")
    If new1 = new2 Then ' 两次输入的一样
        Names("username").RefersTo = "=" & new1
        ThisWorkbook.Save
        MsgBox "密码修改成功"
    Else
        MsgBox "两次密码输入不一致, 修改未完成"
    End If
End Sub

完整的实现:  关闭excel 重新打开进去..

  输入 user  1234  即可进入excel