mfc e将控件置于窗口顶层_VBA学习手册（三）——控件窗体图形化设计

第十二部分 ActiveX控件

一、ActiveX控件属性

ActiveX控件

英文名称	中文名称	特殊属性	通用属性
CommandButton	命令按钮		caption\enable\visible left\top 微调按钮无caption属性
Label	文本框
OptionButton	单选按钮	GroupName、Value
SpinButton	微调按钮控件	Value、min、max

案例：选择题考试系统

Dim max1 As Integer '定义全局变量

Sub max()

max1 = Sheet2.[a1].End(xlDown).Row - 1
Sheet1.SpinButton1.max = max1
Sheet1.SpinButton1.Min = 1

End Sub

Private Sub Worksheet_Activate()

Call max '窗口激活即对微调按钮赋值，并取出题目条数

End Sub

Sub xieru(i As Integer)

With Sheet1

'清空默认勾选
    .OptionButton1.Value = False
    .OptionButton2.Value = False
    .OptionButton3.Value = False
    .OptionButton4.Value = False

'写入题目
    .Label1.Caption = i
    .Label2.Caption = Sheet2.Range("b" & i + 1)

    .Label3.Caption = Sheet2.Range("c" & i + 1)
    .Label4.Caption = Sheet2.Range("d" & i + 1)
    .Label5.Caption = Sheet2.Range("e" & i + 1)
    .Label6.Caption = Sheet2.Range("f" & i + 1)

'该隐藏的隐藏
If .Label5.Caption = "" Then
        .OptionButton3.Visible = False
Else
        .OptionButton3.Visible = True
End If
If .Label6.Caption = "" Then
        .OptionButton4.Visible = False
Else
        .OptionButton4.Visible = True
End If

'返回之前的答案
If Sheet2.Range("h" & i + 1) = "A" Then
        .OptionButton1.Value = True
ElseIf Sheet2.Range("h" & i + 1) = "B" Then
        .OptionButton2.Value = True
ElseIf Sheet2.Range("h" & i + 1) = "C" Then
        .OptionButton3.Value = True
ElseIf Sheet2.Range("h" & i + 1) = "D" Then
        .OptionButton4.Value = True
End If

End With

End Sub

Private Sub CommandButton2_Click()
'跳转到最后一题

Sheet1.SpinButton1.Value = max1 '防止直接从6跳转到3

Call xieru(max1)

End Sub

Private Sub CommandButton3_Click()
'结束答题

Dim k As Integer

With Sheet1
'禁止更改选项
    .OptionButton1.Enabled = False
    .OptionButton2.Enabled = False
    .OptionButton3.Enabled = False
    .OptionButton4.Enabled = False
    .Label1.Enabled = False
    .Label2.Enabled = False
    .Label3.Enabled = False
    .Label4.Enabled = False
    .Label5.Enabled = False
    .Label6.Enabled = False

End With

For i = 2 To max1 + 1

If Sheet2.Range("g" & i).Value = Sheet2.Range("h" & i) Then
        k = k + 1
End If

Next

MsgBox "你共答对了 " & k & "/" & max1 & " 的题目"

End Sub

Private Sub CommandButton5_Click()
'开始答题

Sheet2.Range("h2", "h" & max1 + 1) = ""

With Sheet1
'解除各文本、按钮封印
    .OptionButton1.Enabled = True
    .OptionButton2.Enabled = True
    .OptionButton3.Enabled = True
    .OptionButton4.Enabled = True
    .Label1.Enabled = True
    .Label2.Enabled = True
    .Label3.Enabled = True
    .Label4.Enabled = True
    .Label5.Enabled = True
    .Label6.Enabled = True

End With

Sheet1.SpinButton1.Value = 1

Call xieru(1)

End Sub

Private Sub OptionButton1_Click()
'答案记录到表格中

Sheet2.Range("H" & Sheet1.SpinButton1.Value + 1) = "A"

End Sub

Private Sub SpinButton1_Change()

Call xieru(Sheet1.SpinButton1.Value)

End Sub

第十三部分 窗体与控件

一、窗体属性及方法

英文名：userform

属性：showmadle 是否独占显示

方法：show\hide

其他控件全部的属性，来自微软：

常规	AutoLoad(Excel)	打开工作簿时是否加载控件。(如果是 ActiveX 控件，则忽略。)
	Enabled(表单)	控件是否可以接收焦点并响应用户生成的事件。
	Locked(表单)	控件是否可编辑。
	Name(表单)	控件的名称。
	Placement(Excel)	控件附加到其下方单元格的方式(自由浮动、移动但不调整大小，或者移动并调整大小)。
	PrintObject(Excel)	控件是否可打印。
	Visible(表单)	控件是可见还是隐藏。
大小和位置	AutoSize(表单)	控件的大小是否可以自动调整以显示所有内容。
	Height、Width(表单)	高度或宽度(以磅为单位)。
	Left、Top(表单)	控件与工作表的左边缘或上边缘之间的距离。
	Orientation(表单)	方向为垂直还是水平。
格式设置	BackColor(表单)	背景色。
	BackStyle(表单)	背景样式(透明或不透明)。
	BorderColor(表单)	边框的颜色。
	BorderStyle(表单)	边框的类型(无或单线)。
	ForeColor(表单)	前景色。
	Shadow(Excel)	控件是否有阴影。
	SpecialEffect(表单)	边框的可视外观(平面、凸起、凹陷、蚀刻或凸块)。
键盘和鼠标	Accelerator(表单)	控件的快捷键。
	MouseIcon(表单)	自定义鼠标图标。
	MousePointer(表单)	用户将鼠标放在特定对象上时显示的指针类型(例如，标准指针、箭头、I 型)。
	TakeFocusOnClick(表单)	单击时控件是否获得焦点。
数据和绑定	LinkedCell(Excel)	链接至控件值的区域。
	Value(表单)	控件的内容或状态。
特定于滚动条	Delay(表单)	单击一次滚动条后的延迟(以毫秒为单位)。
	LargeChange(表单)	用户单击滚动框与任一滚动箭头之间的区域时所发生的移动量。
	Max、Min(表单)	允许的最大值和最小值。
	ProportionalThumb(表单)	滚动框的大小是固定还是按一定比例随滚动区域变化。
	SmallChange(表单)	用户单击控件中的滚动箭头时发生的移动量。
特定于结构	Cycle(表单)	当用户离开结构或页面上的最后一个控件时要执行的操作(所有表单或当前表单)。
	KeepScrollBarsVisible(表单)	在不需要时滚动条是否保持可见。
	ScrollBars(表单)	控件是否具有垂直滚动条和/或水平滚动条。
	ScrollHeight、ScrollWidth(表单)	通过移动滚动条可以查看的整个区域的高度或宽度(以磅为单位)。
	ScrollLeft、ScrollTop(表单)	逻辑表单的左边缘或上边缘与结构的左边缘或上边缘之间的距离(以磅为单位)。
	Zoom(表单)	结构内图像大小的更改量。
特定于列表框	BoundColumn(表单)	多个列的数据源。
	ColumnCount(表单)	要显示的列数。
	ColumnHeads(表单)	作为列标题的单个行。
	ColumnWidths(表单)	每列的宽度。
	ListFillRange(Excel)	用于填充列表的区域。
	ListStyle(表单)	列表样式(普通、带有选项按钮或带有复选框)。
	MatchEntry(表单)	在用户键入时控件搜索其列表的方式(首字母、整个条目或者未指定)
	TextColumn(表单)	当用户选择一行时要存储到“Text”属性中的列。
	TopIndex(表单)	出现在列表中的最顶端位置的项目。
图像	Picture(表单)	要在控件中显示的位图。
	PictureAlignment(表单)	背景图片的位置(左上部、右上部、居中等)。
	PicturePosition(表单)	图片与其标题的相对位置(左侧、顶部和右侧等)。
	PictureSizeMode(表单)	背景图片在控件上的显示方式(裁剪、拉伸或缩放)。
	PictureTiling(表单)	是否要在控件中平铺图片的多个副本。
文本	Bold、Italic、Size、StrikeThrough、Underline、Weight(表单)	字体属性(加粗、倾斜、字号、删除线、下划线和粗细)。
	Caption(表单)	在控件上标识或描述控件的说明性文本。
	IMEMode(表单)	输入法编辑器 (IME) 的默认运行时模式。
	IntegralHeight(表单)	控件的大小是否可调整以显示全部或部分文本行。
	MultiSelect(表单)	是否允许选择多个项目。
	Text(表单)	控件中的文本。
	TextAlign(表单)	文本在控件中的对齐方式(左对齐、居中或右对齐)。
	WordWrap(表单)	控件内容是否在行尾自动换行。

二、案例： 伪造应用程序

Private Sub UserForm_Activate()

'打开文件时仅显示用户窗体
Application.Visible = False

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

'关闭窗体时同时关闭Excel主程序
Application.Quit

End Sub

Private Sub Workbook_Open()

'打开文件即激活用户窗体
UserForm1.Show

End Sub

三、案例：制作密码登录系统

TextBox独有属性：passwordchar *，使用*隐藏密码

Private Sub CommandButton1_Click()

If Me.TextBox1.Value = "张三" Then
    Sheet2.Visible = xlSheetVisible
    Sheet2.Unprotect "VHSJ"

ElseIf Me.TextBox1.Value = "李四" Then
    Sheet3.Visible = xlSheetVisible
    Sheet3.Unprotect "LISI"
End If

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheet2.Visible = xlSheetHidden
Sheet3.Visible = xlSheetHidden

Sheet2.Protect "VHSJ"
Sheet3.Protect "LISI"

End Sub

四、下拉框ComboBox

For i = 1 To 7
'下拉框ComboBox

    UserForm1.ComboBox1.AddItem Sheet1.Range("a" & i)
'可以直接使用数组

Next

Me.ComboBox1.RemoveItem (0)

五、列表框：ListBox

与下拉框类似，不过为平铺展示

六、案例：手机号联想输入

Private Sub TextBox1_Change()

Me.ListBox1.Visible = False

If Len(Me.TextBox1.Value) >= 4 Then
Me.ListBox1.Clear

For i = 2 To 8

If InStr(Sheet1.Range("a" & i), Me.TextBox1.Value) > 0 Then

Me.ListBox1.AddItem Sheet1.Range("a" & i)
Me.ListBox1.Visible = True

End If

Next

End If

End Sub

Private Sub UserForm_Activate()Me.ListBox1.Visible = FalseEnd Sub

Private Sub ListBox1_Click()

Me.TextBox1.Value = Me.ListBox1.Value
Me.ListBox1.Visible = False

End Sub

第十四部分 VBA用户信息交互

一、MsgBox

MsgBox "文字", 1, "发骚专用对话框", "E:\*.chm", 0

msgbox第二参数

数字	显示值
0	确定
1	确定与取消
3	是、否与取消
4	是和否
16	危险图标
48	警告
16384	显示帮助
4+48	使用+连接多项条件

msgbox的返回值

提示	返回值
确定	1
取消	2
终止	3
重试	4
忽略	5
是	6
否	7

二、inputbox

'InputBox方法
i = Application.InputBox(, , , , , , , 2)

InputBox方法最后一个参数取值

表示意义	取值
可使用相加的方式
公式	0
数值	1
文本	2
逻辑值	4
单元格引用	8
错误值	16
数值数组	32

三、选择指定类型文件方法

Sub 打开Excel文件()

Dim arr()
Dim wb As Workbook

arr = Application.GetOpenFilename("Excel文件,*.xls*", 1, "快选", "选择这个", True)

'arr = Application.GetOpenFilename("老表,*.xls,新表,*.xlsx", 2：默认第二组, "快选", "选择这个", True：是否支持多选)

If arr(1) <> "False" Then

For i = LBound(arr) To UBound(arr)
Set wb = Workbooks.Open(arr(i))

'这里可以对每个打开的文件做任意操作

        wb.Close
Next

End If

End Sub

四、Dialogs自带对话框

Sub 调用自带对话框()

Application.Dialogs(5).Show

End Sub

五、案例：可选的多文件合并

Sub 多表合并在一个文件中()

Dim str()
Dim i As Integer
Dim wb, wb1 As Workbook
Dim sht As Worksheet

Set wb1 = ActiveWorkbook
Set sht1 = ActiveSheet

On Error Resume Next '加上这句防止用户点击取消发生的错误
str = Application.GetOpenFilename("Excel数据文件,*.xls*", , , , True)

For i = LBound(str) To UBound(str)
Set wb = Workbooks.Open(str(i))
For Each sht In wb.Sheets
            sht.Copy after:=wb1.Sheets(wb1.Sheets.Count)
            wb1.Sheets(wb1.Sheets.Count).Name = Split(wb.Name, ".")(0) & sht.Name
Next
        wb.Close
Next

End Sub

第十五部分 ADO操作外部数据

不用打开文件，即可操作文件数据

感觉不常用，略过

使用在""中，使用""表示一个"，相当于转义(所有VBA中都遵循)

第十六部分 Shape元素

一、批量插入对应图片

Sub 批量插入对应图片()

Dim shp, shp1 As Shape
Dim i As Integer

For Each shp In Sheet2.Shapes
    shp.Delete
Next


On Error Resume Next

For i = 2 To 9

Set shp1 = Sheet2.Shapes.AddPicture("D:\desktop\软件使用整合\ExcelVBA\img\" & Range("a" & i) & ".jpg", msoFalse, msoCTrue, Sheet2.Range("d" & i).Left, Sheet2.Range("d" & i).Top, Sheet2.Range("d" & i).Width, Sheet2.Range("d" & i).Height)
    shp1.Placement = xlMoveAndSize '随单元格大小和位置改变

Next


End Sub

二、批量修改文件名

Sub 批量修改文件名()

Dim i As Integer

On Error Resume Next

For i = 2 To 9

    Name "D:\desktop\软件使用整合\ExcelVBA\img\" & Range("a" & i) & ".jpg" As "D:\desktop\软件使用整合\ExcelVBA\img\" & Range("e" & i) & ".jpg"

Next

End Sub

三、插入图表

Sub 使用录制宏插入图表()

Dim shp As Shape

Set shp = Sheet1.Shapes.AddChart

shp.Chart.SetSourceData Range("b2:c7")
shp.Chart.ChartType = xlLine
shp.Chart.Axes(xlValue).MinimumScale = 10

End Sub

四、隐藏单选按钮分组框

Sub 隐藏分组框()

Dim shp As Shape

For Each shp In Sheet3.Shapes

'shp.Type均为8，不能进行区分

If shp.Name Like "Group Box*" Then
'If shp.FormControlType = xlGroupBox Then

        shp.Visible = msoFalse

End If


Next

End Sub

五、like：使用通配符

类似word中的通配符

like中的通配符

符号	意义
#	数字
*	一个或多个
?	一个字符
[A-Z]	大写字母
[!a-z]	非小写字母

第十七部分 类的使用

一、变量的调用与作用域

共有与私有代码

private sub 私有的模块
'很多事件都是这种方式

public 公用的模块
'sub默认 public

跨过程调用变量

_____________________
Dim i As Integer
'放在所有代码外侧，但仅限于某一模块
_____________________

跨模块调用

_____________________
Public i As Integer
'放在所有代码外侧，可用于各个模块，窗体内定义的变量不可用于模块中，反之可以
_____________________

二、类模块的方法

'相当于过程
'将普通函数复制到类模块中，可在模块中创建该类的方法
带参或不带参均可

三、类模块属性

Property Get sf()
'相当于函数
'将Function换为Property Get即可；
'get只读属性

sf = Sheets.Count

End Property

四、do while循环

Sub dowhile循环结束()

Do While InputBox("一次密码") <> "111"
'如果上面的条件成立，一直循环
Loop


Do
If InputBox("二次密码") = "113" Then
Exit Do
End If
Loop

End Sub

第十八部分 VBA字典

一、字典：只有两列的数组

使用字典对象，需要在VBA的工具-引用中加载Microsoft Scripting Runtime。

Sub 字典赋值与调用()

Dim dic As New Dictionary

dic.Add "vhsj", 1
dic.Add "lisi", 2
'add方法如果出现重复值会出错

Range("e2") = dic("lisi")

dic.RemoveAll '清除全部字典
End Sub

Sub 常用字典定义方法()

Dim dic As New Dictionary

dic.CompareMode = BinarCompane'区分大小写，默认不区分

For i = 2 To 15
    dic(Range("a" & i).Value) = Range("c" & i).Value
Next
'字典不能保存重复值，常用于去重

[f2:i2] = dic.keys'字典的keys相当于一行的一维数组，如果需要输出为列，需要Application.Transpose方法

End Sub

Sub 数组与字典配合使用()

Dim dic As New Dictionary
Dim arr()

arr = Range("a2:d15")

For i = 2 To 15
    dic(arr(i - 1, 1)) = arr(i - 1, 2)
Next

[f2:K2] = dic.Keys

End Sub

Sub 列表框取出不重复值()

Dim dic As New Dictionary
Dim arr()

arr = Range("a2:d15")

For i = LBound(arr) To UBound(arr)
    dic(arr(i, 1)) = 1
Next

Sheet2.ListBox1.List = dic.Keys

End Sub

'如果不使用加载字典工具，可以使用如下字符创建字典对象
'弊端：没有对应的属性和方法提示

Dim dic
Set dic = CreateObject("scripting.dictionary")

二、实例：制作购物车

Dim arr()
Dim ID As String
Dim DJ As Long

Private Sub UserForm_Activate()

arr() = Sheet1.Range("a2:e15")

Dim dic
Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(arr) To UBound(arr)

dic(arr(i, 2)) = 1

Next

Me.ListBox1.List = dic.keys

Me.ListBox4.AddItem
Me.ListBox4.List(0, 0) = "ID"
Me.ListBox4.List(0, 1) = "YI"
Me.ListBox4.List(0, 2) = "ER"
Me.ListBox4.List(0, 3) = "SJ"
Me.ListBox4.List(0, 4) = "数量"
Me.ListBox4.List(0, 5) = "总价"

Me.TextBox1.Value = 1

End Sub

Private Sub ListBox1_Click()

Dim dic
Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(arr) To UBound(arr)
If arr(i, 2) = Me.ListBox1.Value Then
        dic(arr(i, 3)) = 1
End If
Next
Me.ListBox2.Clear
Me.ListBox2.List = dic.keys
Me.ListBox3.Clear
Me.Label2.Caption = "0"

End Sub

Private Sub ListBox2_Click()

Dim dic
Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(arr) To UBound(arr)
If arr(i, 2) = Me.ListBox1.Value And arr(i, 3) = Me.ListBox2.Value Then
        dic(arr(i, 4)) = 1
End If
Next

Me.ListBox3.Clear
Me.ListBox3.List = dic.keys
Me.Label2.Caption = "0"

End Sub

Private Sub ListBox3_Click()

Dim dic
Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(arr) To UBound(arr)
If arr(i, 2) = Me.ListBox1.Value And arr(i, 3) = Me.ListBox2.Value And arr(i, 4) = Me.ListBox3.Value Then
        DJ = arr(i, 5)
Me.Label2.Caption = DJ
        ID = arr(i, 1)

Exit For

End If
Next

End Sub

Private Sub CommandButton1_Click()
'添加到购物车按钮

If DJ > 0 And Me.TextBox1.Value > 0 Then '如果上面的listbox均选择，DJ会取到值

Me.ListBox4.AddItem
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 0) = ID 'ListCount-1即为新添加的行
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 1) = Me.ListBox1.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 2) = Me.ListBox2.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 3) = Me.ListBox3.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 4) = Me.TextBox1.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 5) = DJ * Me.TextBox1.Value
Me.TextBox1.Value = 1

Me.Label5.Caption = Me.Label5.Caption + DJ * Me.TextBox1.Value

    DJ = 0 '重置DJ，防止下次出错，且需要在计算总价之后
Else

MsgBox ("请正确添加商品")

End If

End Sub

ListBox4设置的属性：ColumnCount = 4，ColumnWiths = 40,40,40,40,40

Private Sub CommandButton2_Click()
'删除不需要的商品

If Me.ListBox4.Selected(0) = False Then '防止删除标题行

For i = 0 To Me.ListBox4.ListCount - 1

If Me.ListBox4.Selected(i) = True Then
Me.Label5.Caption = Me.Label5.Caption - Me.ListBox4.List(i, 5)

Me.ListBox4.RemoveItem (i)
End If
Next

End If

End Sub

Private Sub CommandButton3_Click()
'点击完成，添加到数据库中

Dim ddid As String
Dim i As Integer

i = Sheet2.Range("a65536").End(xlUp).Row + 1

ddid = Format(VBA.Now, "yyyymmddhhssdd")

If Me.ListBox4.ListCount > 1 Then

For j = 1 To Me.ListBox4.ListCount - 1

        Sheet2.Range("a" & i) = "D" & ddid
        Sheet2.Range("b" & i) = Date
        Sheet2.Range("c" & i) = Me.ListBox4.List(j, 0)
        Sheet2.Range("d" & i) = Me.ListBox4.List(j, 4)
        Sheet2.Range("e" & i) = Me.ListBox4.List(j, 5)
        i = i + 1

Next

    MsgBox ("结算成功")

    Unload Me

Else
    MsgBox "还没有选择商品呢"

End If


End Sub

第十九部分 操作Access表

此章节由于我日常用的不多，略过。

第二十部分 动作、函数库使用

将文件命名为.xlam的宏函数文件

复制到：C:\Program Files\Microsoft Office\root\Office16\XLSTART(需有管理员权限，为所有用户添加)

至此，全部笔记记录完成，希望可以给你带来一丢丢帮助。