他山之石——VBA文本框

继续学习VBA！

'**********************文字框控件***************
'一 显示
  '1 多行显示
     'MultiLine 属性值为true时，可以多行显示文本
  '2 文本框对齐
     '左右对齐可以用TextAlign对齐，但上下对齐则没有相应的属性设置
  '3 密码样式
     '可以设置passwordChar属性来隐藏输入的内容
  '4 行列超过宽度或高度时添加滚动条
     'ScrollBars 属性可以设置垂直和水平滚动条
  '5 强制换行符号
     'EnterKeyBehavior的属性值为TRUE时,可以强制换行.按回车即可以转到下一行.
     '如果用代码,可以借用回车符来实现转行
Private Sub CommandButton1_Click()
  TextBox2 = "excelpx" & Chr(10) & ".com"  'Cha(10)换行符
End Sub


'二 功能
   '1 自动跳到一下个tab顺序的控件
     'AutoTab属性设置为true，当文字框输入字符数大于
   '2 锁定文本和禁用
      'locked属性为true时，显示正常，可以选取，可以复制，但不能编辑。
      'enable属性为false时，显示灰色，不能选取
   '3 是否允许拖放复制值
      'DragBehavior 属性值为1时,可以进行拖放
      
'三 常用方法和属性
   '1 lineCount属性:获得文本框的行数
   '2 SelLength属性可以获得当前文本框中选取的文本长度
   '3 SelText,可以获得当前文本框中选取的文本
   '4 SetFocus 获得焦点
   Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    ' TextBox2 = TextBox3.SelLength & ":" & TextBox3.SelText & ":" & TextBox3.SelStart
   End Sub



Private Sub UserForm_Click()

End Sub

'四 事件
  '1 当文本框值发生改变量时的事件
   Private Sub 用户名_Change()
     MsgBox 123
   End Sub
   '2 当离开文本框时，如果数据发生了改变，则发生此事件
   Private Sub TextBox1_AfterUpdate()
    ' MsgBox 123
   End Sub
  '3 焦点进入文本框时的事件
  Private Sub 用户名_Enter()
   ' MsgBox "我是用户名。"
  End Sub
  '4 离开文本框时的事件
  Private Sub 用户名_Exit(ByVal Cancel As MSForms.ReturnBoolean) '必须输入用户名
    If 用户名.Text = "" Then
      Cancel = True
      MsgBox "你没有输入用户名，不能跳过" & Chr(10) & "请输入内容"
    End If
  End Sub
  'Cancel参数常用于取消该事件的发生,本事件是指取消离开动作，禁止离开
  
 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) '密码必须输入数字
    If Not VBA.IsNumeric(TextBox1.Value) And TextBox1.Value <> "" Then
      Cancel = True
      MsgBox "密码只能输入数字，请重新输入"
    End If
 End Sub

Private Sub UserForm_Initialize()
Dim arr, x
 日期 = Date
 Set d = CreateObject("scripting.dictionary")
 arr = Sheets("sheet3").Range("G2:H4")
 For x = 1 To UBound(arr)
   d(arr(x, 1)) = arr(x, 2)
 Next x
End Sub



Private Sub 金额_Change()

End Sub

Private Sub 数量_Exit(ByVal Cancel As MSForms.ReturnBoolean) '离开数量后就自动输入到单元格中
Dim myrow As Long, x
    If VBA.IsNumeric(数量.Value) Then
        With Sheets("sheet3")
         myrow = .Range("a65536").End(xlUp).Row + 1
         .Cells(myrow, 1) = 日期
         .Cells(myrow, 2) = 商品
         .Cells(myrow, 3) = 数量.Value
         .Cells(myrow, 4) = 单价.Value
         .Cells(myrow, 5) = 金额.Value
        End With
         商品 = ""
    Else
       MsgBox "数量不能为非数字，请重新输入"
       Cancel = True
    End If
 ' End If
End Sub

Private Sub 数量_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  
End Sub
Private Sub 商品_Exit(ByVal Cancel As MSForms.ReturnBoolean) '根据商品查找单价
 '提取商品单价
  If d.Exists(商品.Value) Then
   单价 = d(商品.Value)
  Else
    MsgBox "该商品单价不存在，请重新输入"
    Cancel = True
  End If
End Sub

Private Sub 数量_Change() '输入数量后自动计算金额
  If VBA.IsNumeric(数量.Value) Then
   金额 = 数量 * 单价
  End If
End Sub