第6章 控件与用户窗体

范例67 文本框只能输入数值

Private Sub TextBox1_KeyPress(ByVal KeyANSI As MSForms.ReturnInteger) With TextBox1

Select Case KeyANSI

Case Asc(\ Case Asc(\

If InStr(1, .Text, \ KeyANSI = 0 End If

Case Asc(\

If InStr(1, .Text, \ Case Else

KeyANSI = 0 End Select End With End Sub

Private Sub TextBox1_Change() Dim i As Integer Dim Str As String With TextBox1

For i = 1 To Len(.Text) Str = Mid(.Text, i, 1) Select Case Str

Case \ Case Else

.Text = Replace(.Text, Str, \ End Select Next End With End Sub

42

范例68 限制文本框的输入长度

Private Sub TextBox1_Change() TextBox1.MaxLength = 6 End Sub

范例69 验证文本框输入的数据

Private Sub CommandButton1_Click() With TextBox1

If (Len(Trim(.Text))) = 15 Or (Len(Trim(.Text))) = 18 Then Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = .Text Else

MsgBox \身份证号码错误，请重新输入!\ End If

.Text = \ .SetFocus End With End Sub

范例70 文本框回车自动输入

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Dim r As Integer

r = Cells(Rows.Count, 1).End(xlUp).Row With TextBox1

If Len(Trim(.Text)) > 0 And KeyCode = vbKeyReturn Then Cells(r + 1, 1) = .Text .Text = \ End If End With End Sub

范例71 文本框的自动换行

Private Sub UserForm_Initialize() With TextBox1

.WordWrap = True

43

.MultiLine = True

.Text = \文本框是一个灵活的控件，受下列属性的影响：Text、\ & \、WordWrap和AutoSize。\ & \包含显示在文本框中的文本。\ & \控制文本框是单行还是多行显示文本。\ & \换行字符用于标识在何处结束一行并开始新的一行。\ & \如果 MultiLine 的值为False，则文本将被截断，\ & \而不会换行。如果文本的长度大于文本框的宽度，\

& \允许文本框根据其宽度自动换行。\ & \如果不使用 WordWrap，当文本框在文本中遇到换行字符时，\ & \开始一个新行。如果关闭WordWrap，TextBox中可以有不能\ & \完全适合其宽度的文本行。文本框根据该宽度，显示宽度以\ & \内的文本部分，截断宽度以外的那文本部分。只有当\

& \为True时，WordWrap才起作用。\ & \控制是否调节文本框的大小，以便显示所有文本。\ & \当文本框使用AutoSize 时，文本框的宽度按照文本框中的\ & \文字量以及显示该文本的字体大小收缩或扩大。\ End With End Sub

范例72 格式化文本框数据

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, \End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox2 = Format(TextBox2, \End Sub

范例73 使控件始终位于可视区域

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range

Set rng = ActiveWindow.VisibleRange.Cells(1) With CommandButton1 .Top = rng.Top .Left = rng.Left End With

With CommandButton2 .Top = rng.Top

.Left = rng.Left + CommandButton1.Width 44

End With

Set rng = Nothing End Sub

范例74 高亮显示按钮控件

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

With Me.CommandButton1 .BackColor = &HFFFF00 .Width = 62 .Height = 62 .Top = 69 .Left = 31 End With End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

With Me.CommandButton1

.BackColor = Me.BackColor .Width = 60 .Height = 60 .Top = 70 .Left = 32 End With End Sub

范例75 列表框添加列表项的方法

75-1 使用RowSource属性

Private Sub UserForm_Initialize() Dim r As Integer

r = Sheet3.Range(\ ListBox1.RowSource = \End Sub

75-2 使用ListFillRange属性

Sub ListFillRange()

45