第十二部分 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
数字 | 显示值 |
---|---|
0 | 确定 |
1 | 确定与取消 |
3 | 是、否与取消 |
4 | 是和否 |
16 | 危险图标 |
48 | 警告 |
16384 | 显示帮助 |
4+48 | 使用+连接多项条件 |
提示 | 返回值 |
---|---|
确定 | 1 |
取消 | 2 |
终止 | 3 |
重试 | 4 |
忽略 | 5 |
是 | 6 |
否 | 7 |
'InputBox方法
i = Application.InputBox(, , , , , , , 2)
表示意义 | 取值 |
---|---|
可使用相加的方式 | |
公式 | 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中的通配符
符号 | 意义 |
---|---|
# | 数字 |
* | 一个或多个 |
? | 一个字符 |
[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(需有管理员权限,为所有用户添加)
至此,全部笔记记录完成,希望可以给你带来一丢丢帮助。