wdmexcel / 待分类 / VBA常用代码解析(第四十三讲)

分享

   

VBA常用代码解析(第四十三讲)

2015-10-27  wdmexcel

152 在用户窗体上添加状态栏

在▲148 、▲149 中我们在用户窗体上添加了菜单和工具栏,为了使窗体更像正规的软件,还需要在用户窗体的底部添加一个状态栏,用于显示程序的各种状态信息。

在用户窗体上添加状态栏使用StatusBar控件,StatusBar控件用于设计窗体状态栏,状态栏由一组连续的窗格(最多16)对象组合而成,用于显示应用程序当前的工作状态,其位置通常在应用程序窗体的底部。在设计模式下右键单击“工具箱”,在显示的右键菜单中选择“附加控件”,在对话框中选择“Microsoft StatusBar Controlveision 6.0控件,拖动后就可以在用户窗体上添加一个StatusBar控件。

在用户窗体上添加了StatusBar控件后还需要添加窗格,可以在StatusBar控件的属性页中进行设置和添加,在StatusBar控件的属性窗口中选择“自定义”按钮,在属性页中设置属性和添加窗格。

也可以在代码运行时对其进行属性设置和添加窗格,双击用户窗体写入下面的代码:

Private Sub UserForm_Initialize()

……使用API函数添加菜单代码略,详见附件。

Dimarr As Variant

Dimi As Byte

……使用Toolbar控件添加工具栏代码略,详见附件。

arr= Array(065)

WithStatusBar1

.Width = Me.Width - 10

For i = 1 To 3

.Panels.Add(i,,““).Style = arr(i - 1)

Next

.Panels(1).Text = '准备就绪!'

.Panels(2).Width = 60

.Panels(3).Width = 75

.Panels(1).Width = Me.Width - .Panels(1).Width- .Panels(2).Width

.Panels(3).Picture = LoadPicture(ThisWorkbook.Path& '\123.BMP')

For i = 0 To 2

.Panels(i + 1).Alignment = i

Next

EndWith

End Sub

代码解析:

8行代码设置StatusBar控件的宽度比用户窗体略小一点。

9行到第11行代码在StatusBar控件中添加三个窗格并指定窗格的样式。添加窗格需要在Panels集合对象中使用Add方法,语法如下:

object.Panels.Add(indexkeytextstylepicture)

参数object是必需的,代表StatusBar对象。

参数index是可选的,指定新增窗格的索引值,该索引值决定了窗格在StatusBar控件中的位置。如果省略index参数新增窗格添加到Panels集合的最后。

参数key是可选的,指定新增窗格的关键字。

参数text是可选的,指定新增窗格中显示的文本。

参数style是可选的,指定新增窗格的样式,设置值如表格所示。

参数picture是可选的,指定新增窗格载入的图像。

12行代码设置第一个窗格显示的文本。

13行到第15行代码设置三个窗格的宽度。

16行代码为第三个窗格加载指定的图像。

17行到第19行代码设置三个窗格中文本的对齐方式。Panels对象的Alignment属性返回或设置窗格中文本的对齐方式,设置值如表格所示。

在示例中使用StatusBar控件的第一个窗格在用户窗体的文本框输入时显示所输入的内容,需要在文本框中写入下面的代码。

Private Sub TextBox1_Change()

StatusBar1.Panels(1).Text= '正在录入:' & TextBox1.Text

End Sub

代码解析:

文本框的Change事件过程,将文本框中输入的内容显示在StatusBar控件的第一个窗格中。运行窗体后在窗体上添加状态栏。

9部分函数的使用

153 调用工作表函数求和

在对工作表的单元格区域进行求和计算时,使用工作表Sum函数比使用VBA代码遍历单元格进行累加求和效率要高得多,代码如下所示。

Sub rngSum()

Dimrng As Range

Dimd As Double

Setrng = Range('A1:F7')

d =Application.WorksheetFunction.Sum(rng)

MsgBoxrng.Address(00) & '单元格的和为' & d

End Sub

代码解析:

rngSum过程调用工作表Sum函数对工作表的单元格区域进行求和计算。

VBA中调用工作表函数需要在工作表函数前加上WorksheetFunction属性。应用于Application对象的WorksheetFunction属性返回WorksheetFunction对象,作为VBA中调用工作表函数的容器,在实际应用中可省略Application对象识别符。

154 查找最大、最小值

VBA中没有内置的函数可以进行最大、最小值的查找,借助工作表MaxMin函数可以快速地在工作表区域中查找最大、最小值,如下面的代码所示。

Sub seeks()

Dimrng As Range

DimmyRng As Range

Dimk1 As Integerk2 As Integer

Dimmax As Doublemin As Double

SetmyRng = Sheet1.Range('A1:F30')

ForEach rng In myRng

If rng.Value = WorksheetFunction.max(myRng)Then

rng.Interior.ColorIndex = 3

k1 = k1 + 1

max = rng.Value

ElseIf rng.Value = WorksheetFunction.min(myRng)Then

rng.Interior.ColorIndex = 5

k2 = k2 + 1

min = rng.Value

Else

rng.Interior.ColorIndex = 0

End If

Next

MsgBox'最大值是:' & max & '共有 ' & k1 & '' _

& Chr(13) & '最小值是:' & min & '共有 ' & k2 & ''

End Sub

代码解析:

seeks过程在工作表单元格区域中查找最大、最小值,并将其所在的单元格底色分别设置为红色和蓝色。

2行到第5行代码声明变量类型。

6行代码使用关键字Set将单元格引用赋给变量myRng

7行到第19行代码遍历单元格区域,使用工作表MaxMin函数判断单元格数值是否是所在区域的最大、最小值,如果是,将其所在的单元格底色设置为红色或蓝色,并保存其数值和数量。

2021行代码使用消息框显示最大、最小值数值和数量。

运行seeks过程后将工作表区域最大、最小值所在的单元格的底色设置为红色或蓝色并用消息框显示其数值和数量。

155 不重复值的录入

在工作表中录入数据时,有时希望能限制重复值的录入,比如在示例的A列单元格只能录入唯一的人员编号,此时可以利用工作表的Change事件结合工作表的CountIf 函数来判断所录入的人员编号是否重复,示例代码如下。

Private Sub Worksheet_Change(ByVal Target As Range)

WithTarget

If .Column <> 1 Or .Count > 1 ThenExit Sub

If Application.CountIf(Range('A:A').Value) > 1 Then

.Select

MsgBox '不能输入重复的人员编号!'64

Application.EnableEvents = False

.Value = ““

Application.EnableEvents = True

End If

EndWith

End Sub

代码解析:

工作表的Change事件过程,使A列单元格只能录入唯一的人员编号。

4行代码使用工作表的CountIf函数来判断在A列单元格输入的人员编号是否重复。工作表的CountIf 函数计算区域中满足给定条件的单元格的个数,语法如下:

COUNTIF(rangecriteria)

参数range为需要计算其中满足条件的单元格数目的单元格区域。

参数criteria为确定哪些单元格将被计算在内的条件,其形式可以为数字、表达式、单元格引用或文本。

在示例中以所录入的人员编号与A列单元格区域进行比较,如果CountIf函数的返回值大于1,说明录入的是重复编号。

5行代码,重新选择该单元格便于下一步清空后重新录入。

789行代码,清除录入的重复编号,在清除前将Application对象的EnableEvents属性设置为False,禁用事件。因为如果不禁用事件,那么在清除重复值的过程中会不断地触发工作表的Change事件,从而造成代码运行的死循环。

经过以上的设置,在工作表的A列中只能录入唯一的人员编号,如果录入重复值会进行提示,点击确定后自动清除录入的重复编号。

156 获得当月的最后一天

在实际工作中经常需要根据给定的日期计算其所属月份的最后一天,此时可以使用DateSerial函数完成计算,如下面的代码所示。

Sub Serial()

DimDateStr As Byte

DateStr= Day(DateSerial(Year(Date)Month(Date) + 10))

MsgBox'本月的最后一天是' & Month(Date) & '' & DateStr & ''

End Sub

代码解析:

Serial过程配合使用了4VBA内置函数YearMonthDayDateSerial完成计算并使用消息框显示当月最后一天的日期。

YearMonthDay函数分别返回代表指定日期的年、月、日的整数,语法如下:

Year(Date)

Month(Date)

Day(Date)

其中参数Date可以是任何能够表示日期的Variant、数值表达式、字符串表达式或它们的组合。

DateSerial函数返回包含指定的年、月、日的Variant (Date),语法如下:

DateSerial(yearmonthday)

其中参数year monthday分别表示指定的年、月、日。

为了指定某个日期,DateSerial 函数中的每个参数的取值范围应该是可接受的,即日的取值范围应在1-31之间,而月的取值范围应在1-12之间。但是,当一个数值表达式表示某日之前或其后的年、月、日数时,也可以为每个使用这个数值表达式的参数指定相对日期。当任何一个参数的取值超出可接受的范围时,它会自动地在可接受的时间单位进行调整,例如本例中的day参数设置为0,则被解释成month参数指定月的前一天,即表达式Month(Date) + 1指定的下一个月的前一天,也就是本月的最后一天。


    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多
    喜欢该文的人也喜欢 更多

    ×
    ×

    ¥.00

    微信或支付宝扫码支付:

    开通即同意《个图VIP服务协议》

    全部>>