Sub GiDo được viết theo kiểu chẳng cần phải sửa chỗ nào cả
Trong tất cả các bài mà người khác giúp bạn đã có rất nhiều lần người ta đã làm cái SetFocus này theo ý bạn. Ít ra là tôi đã từng đưa ra. Nhưng bạn không chịu nhớ, không chịu ghi lại mà mỗi lần cần đến lại nhờ người khác giúp. Vì bạn có bao giờ tự viết đâu, toàn người khác nhọc công. Đã không chịu học để tự làm thì ít ra phải ghi lại những cái người ta làm hộ. Ai lại nhờđi nhờ lại cái người ta đã giúp mình?
Private Sub ngay1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
GiDo ngay1
KeyCode = 0
End If
End Sub[
Không ai trách bạn không biết cái gì đó. Khi người ta đã hướng dẫn thì phải ghi lại để khỏi hỏi lần nữa. Chuyện ghi lại thì đâu có phụ thuộc vào trí thông minh?
Function GiDo(theTextbox As Control) As Boolean
' xét ngày trong theTextBox và ch?nh d?ng
Dim ngay As String
ngay = ChinhDDMMYYYY(theTextbox.Text)
If ChuanNgay(ngay) Then
theTextbox.Text = ngay
GiDo = True
Else
MsgBox "báo l?i gì dó"
GiDo = False
'theTextbox.SetFocus
End If
End FunctionPrivate Sub ngay1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If GiDo(ngay1) = False Then
Cancel = True
End If
End SubChạy code lấy từ GiDo và chạy - gọi GiDo là 2 vấn đề khác nhau
Sub ngay1_AfteUpdate ()
' xét ngày trong ngay1 và chỉnh dạng
Dim ngay As String
ngay = ChinhDDMMYYYY(ngay1.Text)
If ChuanNgay(ngay) Then
ngay1.Text = ngay
Else
MsgBox "báo lỗi gì đó"
ngay1.SetFocus
End If
End SubPrivate Sub ngay1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim ngay As String
If KeyCode = 13 Then
ngay = ChinhDDMMYYYY(ngay1.Text)
If ChuanNgay(ngay) Then
ngay1.Text = ngay
Else
MsgBox "báo lỗi gì đó"
KeyCode = 0
End If
End If
End SubPrivate Sub ngay1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If GiDo(ngay1) = False Then
KeyCode = 0
End If
End If
End Sub
)
Chả có gì cả. Tôi cố ý chỉ hướng dẫn để bạn tự suy nghĩ và chỉnh sửa code thôi. Còn cơm bưng nước rót tận miệng thì cũng đâu khó gì.
Option Explicit
Private Const Separetor = "/"
Private DelFirstY As Boolean, k3%, YY$, Y%
'Private Function Separetor()'
' Separetor = Mid$(Me.Label1.Value, 5, 1)'
'End Function'
Private Sub SetFontFm(TextBox As MSForms.TextBox, Optional b As Boolean)
With TextBox
.Font.Strikethrough = Not b
.ForeColor = IIf(b, vbBlue, vbRed)
End With
End Sub
Private Function IsDateFM(Text$) As Boolean
Dim T$(), I%
IsDateFM = True
Select Case Len(Text)
Case 10: IsDateFM = IsDate(Text)
Case 4 To 6
T = Split(Text, Separetor)
If UBound(T) < 1 Then Exit Function
I = CInt(T(1))
If I = 0 Then Exit Function
If CInt(T(0)) = 30 Then
IsDateFM = Not (I = 2)
ElseIf CInt(T(0)) = 31 Then
IsDateFM = Not (I = 2 Or I = 4 Or I = 6 Or I = 9 Or I = 11)
End If
End Select
End Function
Private Sub ngay1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case Len(ngay1.Value)
Case 0: SetFontFm ngay1, True: DelFirstY = False: k3 = 0
Case 10: SetFontFm ngay1, IsDateFM(ngay1.Value)
End Select
End Sub
Private Sub ngay1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 46 Then ngay1.Value = "": SetFontFm ngay1, True: k3 = 0: GoTo Ends
Dim L%, T$, Text$, Tmp$, I%, M%, F$
L = Len(ngay1.Value): T = ngay1.Value
Select Case KeyCode
Case 13
Case 48 To 57
Tmp = ChrW(KeyCode): I = CInt(Tmp)
If L >= 10 Then KeyCode = 0: GoTo Ends
Select Case L
Case 0: F = IIf(I > 3, 0, "") & Tmp & IIf(I > 3, Separetor, ""): DelFirstY = False
Case 1
If CInt(T) < 3 Then
F = T & Tmp & Separetor
ElseIf CInt(T) = 3 Then
k3 = k3 + 1
F = T & IIf(I < 2, Tmp & Separetor, "")
If k3 > 1 Then k3 = 0: F = 0 & T & Separetor & 0 & Tmp & YY
End If
Case 3: F = T & IIf(I > 1, 0, "") & Tmp & IIf(I > 1, YY, "")
Case 4
M = CInt(Right$(T, 1))
F = T & IIf((M = 0 And I > 0) Or (M = 1 And I <= 2), Tmp & IIf(DelFirstY, Separetor, YY), "")
Case 6: If I <= Y And I >= 1 Then F = T & Tmp
Case 7: If I <= 2 Or I >= 8 Then F = T & Tmp
Case Else
F = T & Tmp
End Select
KeyCode = 0
Case 8
k3 = 0
If L = 8 And Not DelFirstY Then
F = Left$(T, L - 4): KeyCode = 0: DelFirstY = True
ElseIf Right$(T, 1) = Separetor Then
F = Left$(T, L - 2): KeyCode = 0
End If
Case Else: KeyCode = 0
End Select
Ends:
If F <> vbNullString Then
Dim b As Boolean: b = IsDateFM(F)
If b Then ngay1.Value = F
SetFontFm ngay1, b
End If
End Sub
' Xóa nêu Di Chuyen Con tro ve truoc'
Private Sub ngay1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim L%, Lst%
Lst = ngay1.SelStart: L = Len(ngay1.Value)
If Lst < L Then ngay1.Value = "": k3 = 0: DelFirstY = False
End Sub
' Khoi Tao Form
Private Sub UserForm_Initialize()
YY = Separetor & Left$(CStr(Year(Now)), 2)
Y = CInt(Left$(CStr(Year(Now)), 1))
End SubTôi chỉ giúp bạn loại bỏ lỗi và giữ focus khi cần thiết thôi. Còn chuyện gõ 6 ký tự thì biến thành ngày tháng thì quan điểm của mình tôi đã trình bày. Một khi tôi đã cho là nhí nhố thì tôi sẽ không tham gia viết code.
Option Explicit
Private Const Separetor = "/"
Private DelFirstY As Boolean, k3%, YY$, Y%
'Private Function Separetor()'
' Separetor = Mid$(Me.Label1.Value, 5, 1)'
'End Function'
Private Sub SetFontFm(TextBox As MSForms.TextBox, Optional b As Boolean)
With TextBox
.Font.Strikethrough = Not b
.ForeColor = IIf(b, vbBlue, vbRed)
End With
End Sub
Private Function IsDateFM(Text$) As Boolean
Dim T$(), I%
IsDateFM = True
Select Case Len(Text)
Case 10: IsDateFM = IsDate(Text)
Case 4 To 6
T = Split(Text, Separetor)
If UBound(T) < 1 Then Exit Function
I = CInt(T(1))
If I = 0 Then Exit Function
If CInt(T(0)) = 30 Then
IsDateFM = Not (I = 2)
ElseIf CInt(T(0)) = 31 Then
IsDateFM = Not (I = 2 Or I = 4 Or I = 6 Or I = 9 Or I = 11)
End If
End Select
End Function
Private Sub ngay1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case Len(ngay1.Value)
Case 0: SetFontFm ngay1, True: DelFirstY = False: k3 = 0
Case 10: SetFontFm ngay1, IsDateFM(ngay1.Value)
End Select
End Sub
Private Sub ngay1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 46 Then ngay1.Value = "": SetFontFm ngay1, True: k3 = 0: GoTo Ends
Dim L%, T$, Text$, Tmp$, I%, M%, F$
L = Len(ngay1.Value): T = ngay1.Value
Select Case KeyCode
Case 13
Case 48 To 57
Tmp = ChrW(KeyCode): I = CInt(Tmp)
If L >= 10 Then KeyCode = 0: GoTo Ends
Select Case L
Case 0: F = IIf(I > 3, 0, "") & Tmp & IIf(I > 3, Separetor, ""): DelFirstY = False
Case 1
If CInt(T) < 3 Then
F = T & Tmp & Separetor
ElseIf CInt(T) = 3 Then
k3 = k3 + 1
F = T & IIf(I < 2, Tmp & Separetor, "")
If k3 > 1 Then k3 = 0: F = 0 & T & Separetor & 0 & Tmp & YY
End If
Case 3: F = T & IIf(I > 1, 0, "") & Tmp & IIf(I > 1, YY, "")
Case 4
M = CInt(Right$(T, 1))
F = T & IIf((M = 0 And I > 0) Or (M = 1 And I <= 2), Tmp & IIf(DelFirstY, Separetor, YY), "")
Case 6: If I <= Y And I >= 1 Then F = T & Tmp
Case 7: If I <= 2 Or I >= 8 Then F = T & Tmp
Case Else
F = T & Tmp
End Select
KeyCode = 0
Case 8
k3 = 0
If L = 8 And Not DelFirstY Then
F = Left$(T, L - 4): KeyCode = 0: DelFirstY = True
ElseIf Right$(T, 1) = Separetor Then
F = Left$(T, L - 2): KeyCode = 0
End If
Case Else: KeyCode = 0
End Select
Ends:
If F <> vbNullString Then
Dim b As Boolean: b = IsDateFM(F)
If b Then ngay1.Value = F
SetFontFm ngay1, b
End If
End Sub
' Xóa nêu Di Chuyen Con tro ve truoc'
Private Sub ngay1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim L%, Lst%
Lst = ngay1.SelStart: L = Len(ngay1.Value)
If Lst < L Then ngay1.Value = "": k3 = 0: DelFirstY = False
End Sub
' Khoi Tao Form
Private Sub UserForm_Initialize()
YY = Separetor & Left$(CStr(Year(Now)), 2)
Y = CInt(Left$(CStr(Year(Now)), 1))
End Sub
