Tạo phạm vi nhập liệu cho Textbox trong VBA

LI�N HỆ QUẢNG C�O TẠI Đ�Y : 0988 123 126

Bước 2: Copy toàn bộ code này vào Classmodel vừa tạo.

Tùy chọn rõ ràng

Public WithEvents mTextBox As MSForms.TextBox

Private mMask As String
Private mMaskPlaceholder As String
Private mMaskSeparator As String

Public Enum AllowedKeysEnum
NumberKeys = 1 ‘2 ^ 0
CharacterKeys = 2′ 2 ^ 1
‘để có thêm tùy chọn, các giá trị tiếp theo cần phải là 2 ^ 2, 2 ^ 3, 2 ^ 4,…
End Enum
Private mAllowedKeys As AllowedKeysEnum

Public Sub SetMask(ByVal Mask As String, ByVal MaskPlaceholder As String, ByVal MaskSeparator As String, Optional ByVal AllowedKeys As AllowedKeysEnum = NumberKeys)
mMask = Mask
mMaskPlaceholder = MaskPlaceholder
mMaskSeparator = MaskSeparator
mAllowedKeys = AllowedKeys

mTextBox.Text = mMask
FixSelection
End Sub

‘ move selection so separators get not replaced
Private Sub FixSelection()
With mTextBox
Dim Sel As Long
Sel = InStr(1, .Text, mMaskPlaceholder) – 1
If Sel >= 0 Then
.SelStart = Sel
.SelLength = 1
End If
End With
End Sub

Private Sub mTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim tb As MSForms.TextBox
Set tb = Me.mTextBox

‘allow paste
If Shift = 2 And KeyCode = vbKeyV Then
On Error Resume Next
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject

DataObj.GetFromClipboard
Dim PasteData As String
PasteData = DataObj.GetText(1)

On Error GoTo 0
If PasteData <> vbNullString Then
Dim LikeMask As String
LikeMask = Replace$(mMask, mMaskPlaceholder, “?”)

If PasteData Like LikeMask Then
mTextBox = PasteData
End If
End If
End If

Select Case KeyCode
Case vbKey0 To vbKey9, vbKeyNumpad0 To vbKeyNumpad9
‘allow number keys
If Not (mAllowedKeys And NumberKeys) = NumberKeys Then
KeyCode = 0
ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
KeyCode = 0
End If

Case vbKeyA To vbKeyZ
‘allow character keys
If Not (mAllowedKeys And CharacterKeys) = CharacterKeys Then
KeyCode = 0
ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
KeyCode = 0
End If

Case vbKeyBack
‘allow backspace key
KeyCode = 0
If tb.SelStart > 0 Then ‘only if not first character
If Mid$(tb.Text, tb.SelStart, 1) = mMaskSeparator Then
‘jump over separators
tb.SelStart = tb.SelStart – 1
End If

‘remove character left of selection and fill in mask
If tb.SelLength <= 1 Then
tb.Text = Left$(tb.Text, tb.SelStart – 1) & Mid$(mMask, tb.SelStart, 1) & Right$(tb.Text, Len(tb.Text) – tb.SelStart)
End If
End If

‘if whole value is selected replace with mask
If tb.SelLength = Len(mMask) Then tb.Text = mMask

Case vbKeyReturn, vbKeyTab, vbKeyEscape
‘allow these keys

Case Else
‘disallow any other key
KeyCode = 0
End Select

FixSelection
End Sub

Private Sub mTextBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
FixSelection
End Sub

Bước 3 :  Bạn cần có 1 tạo 1 USERFORM và 1 TEXTBOX có tên là NHAPLIEUDATA

Bước 4 : Bạn bấm View CODE USERFORM  Copy code này vào

Private MaskedTextBoxes As Collection
Private Sub UserForm_Initialize()
Set MaskedTextBoxes = New Collection
Dim MaskedTextBox As MaskedTextBox
‘init TextBox1 as date textbox
Set MaskedTextBox = New MaskedTextBox
Set MaskedTextBox.mTextBox = Me.NHAPLIEUDATE
MaskedTextBox.SetMask Mask:=”__/__/____”, MaskPlaceholder:=”_”, MaskSeparator:=”/”
MaskedTextBoxes.Add MaskedTextBox
End Sub

Bạn có thể chỉnh lại khai báo chỗ ME.NhAPLIEUDATE , khai báo tên textboxt đã được tạo, bạn có thể sưa lại chổ này __/__/____ theo tùy thích của bạn.

3 – Tải về

CLICK VÀO ĐÂY ĐỂ TẢI DEMO

Như vậy, mình đã giới thiệu đến các bạn các tạo phạm vi nhập liệu cho Textbox trong VBA. Hy vọng, bài viết này sẽ mang đến sự hữu ích cho các bạn trong việc học tập, cũng như công việc. Nếu các bạn có ý kiến, thắc mắc gì thì hãy để bình luận phía bên dưới nhé. Chúc các bạn thành công, cảm ơn các bạn đã ghé thăm Tinvanphong.com.

Tham khảo thêm các bài viết.

Phần mềm xuất nhập tồn bằng Excel miễn phí 2021

Chuyển đổi số thành chữ viết bằng Code VBA