www.giaiphapexcel.com
Thử Code
Sub Ngay_ddmmyy()
Dim Ngay As String, tmp As String
Ngay = TextBoxl.Text
If Len(Ngay) = 6 Then
If IsDate("20" & Mid(Ngay, 5, 2) & "/" & Mid(Ngay, 3, 2) & "/" & Mid(Ngay, 1, 2)) Then
TextBoxl.Text = Mid(Ngay, 1, 2) & "/" & Mid(Ngay, 3, 2) & "/" & "20" & Mid(Ngay, 5, 2)
Exit Sub
End If
End If
MsgBox ("Du Lieu Ngay Thang Sai Bet !")
End SubThêm hướng dẫn
Sub Ngay_ddmmyy()
Dim Ngay As String
Ngay = TextBoxl.Text
If Len(Ngay) = 6 Then
If IsDate("20" & Mid(Ngay, 5, 2) & "/" & Mid(Ngay, 3, 2) & "/" & Mid(Ngay, 1, 2)) Then
TextBoxl.Text = Mid(Ngay, 1, 2) & "/" & Mid(Ngay, 3, 2) & "/" & "20" & Mid(Ngay, 5, 2)
Exit Sub
End If
End If
TextBoxl.Text = ""
Ngay= MsgBox ("Nhap Lai theo dang: ddmmyy", 0, "Du Lieu Ngay Thang Sai Bet !")
End SubRange("B3").Value = TextBox1.ValueRange("B3").Value = CDate(TextBox1.Value)Sub Ngay_ddmmyy()
Dim Ngay As String
Ngay = TextBoxl.Text
If Len(Ngay) = 6 Then
If IsDate("20" & Mid(Ngay, 5, 2) & "/" & Mid(Ngay, 3, 2) & "/" & Mid(Ngay, 1, 2)) Then
TextBoxl.Text = Mid(Ngay, 1, 2) & "/" & Mid(Ngay, 3, 2) & "/" & "20" & Mid(Ngay, 5, 2)
Exit Sub
End If
End If
TextBoxl.Text = ""
Ngay= MsgBox ("Nhap Lai theo dang: ddmmyy", 0, "Du Lieu Ngay Thang Sai Bet !")
TextBox1.SetFocus <-----chen them
End SubSub 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 SubFunction NumOfDaysInMonth(m As Integer, y As Integer) As Integer
' hàm tính số ngày tối đa trong tháng
' nếu tháng năm ngoài giới hạn 1-12 thì nó trả về 0
Select Case m
Case 1, 3, 5, 7, 8, 10, 12
NumOfDaysInMonth = 31
Case 4, 6, 9, 11
NumOfDaysInMonth = 30
Case 2 ' tháng 2 hơi rắc rối
If y Mod 4 Then
NumOfDaysInMonth = 28 ' không phải năm nhuần
Else If y Mod 100 = 0 And y Mod 400 <> 0 Then
NumOfDaysInMonth = 28 ' năm thế kỷ không phải năm nhuần, trừ năm 4 thế kỷ
Else
NumOfDaysInMonth = 29
End If
Case Else
NumOfDaysInMonth = 0 ' không phải đúng tháng
End Select
End Function
Function IsValidDMY(d As Integer, m As Integer, y As Integer) As Boolean
If d < 1 Then Exit Function
If d > NumOfDaysInMonth(m, y) Then Exit Function
NumOfDaysInMonth = True
End Function
Cái vụ ngày tháng này khó thì không khó, dễ thì không dễ, nếu bạn làm chương trình, thì theo mình nghĩ chỉ có cách bắt người sài nhập ngày tháng năm theo ý đồ của bạn. Vì trong thực tế thì sẽ phát sinh nhiều trường hơp lắm...
