gõ 6 số ra ngày tháng năm trong textbox

[NguyenthiH]

Chào các anh chị. Em có textbox ngày trong Userform, em muốn chỉ gõ 6 số và enter là ra ngày tháng năm được không ạ.
Ví dụ như em gõ:
310719 enter thì ra ngày 31/07/2019
030819 enter thì ra ngày 03/08/2019.
Mong các anh chị chỉ giáo ạ.

 

[VetMini]

Sao em bê nguyên code của anh @VetMini và sửa "thetextbox" thành "ngay1" theo tên textbox ngày của em, và thêm GiDo vào sub ngay1_AfteUpdate () thì lỗi tại GiDo anh @VetMini ơi.

Sub GiDo được viết theo kiểu chẳng cần phải sửa chỗ nào cả
(ngoại trừ lúc đầu có 1 chỗ tôi gõ nhầm theTextBox thành meTextBox, nhưng sau đó tôi đã chỉnh lại)
Bạn chỉ cần nạp tên cái TextBox làm tham cbo nó thôi.

Sub ngay1_AfterUpdate()
GiDo ngay1
' nếu có vài textbox thì thêm:
GiDo ngay2
GiDo ngay3
End Sub

Chú: xin lỗi, tôi mới nhìn ra cái tham tôi gõ thiếu ký tự 'o', đáng lẽ phải là theTextBox thay vì theTextBx
Sub GiDo(theTextbx As Control)
cần chỉnh thành
Sub GiDo(theTextBox As Control)

 

[NguyenthiH]

Cám ơn anh @VetMini nhiều.

 

[NguyenthiH]

Xin các anh chỉnh code để khi hiện msgbox lỗi do gõ ngày sai thì textbox ngay1 được focus ạ.

 

[batman1]

Cám ơn Thầy @batman1, em chỉnh theo Thầy thì không lỗi nữa, nhưng ý em khi có msgBox báo lỗi ->enter -> textbox ngay1 được focus, để gõ lại ạ.
Code của anh Hiếu, và anh Vetmini khi báo lỗi lại nhảy qua textbox khá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?

Bạn hãy rà soát lại tất cả các tập tin cũ của mình. Có đúng là có rất nhiều tập tin có kiểu SetFocus cho chính TextBox hiện hành không? Tôi nhớ thì chả lý gì bạn lại không nhớ các tập tin của mình. Thậm chí nếu không ghi lại và không nhớ rõ cách làm thì chỉ cần mở lại các tập tin cũ. Trong 99,99% tập tin bạn có kiểu SetFocus cho TextBox hiện hành. Tôi biết vì đây là món "tủ" của bạn. Nhưng tìm lại mất công đúng không? Thà người khác mất công chứ bạn không muốn mất công trong chính vấn đề của mình.

Vài viên "thuốc đắng", hi vọng chữa khỏi bệnh.

Gợi ý: Cho code vào ngay1_KeyDown thay cho ngay1_AfteUpdate. Kiểm tra nếu thấy KeyCode = 13 thì làm việc. Nếu có lỗi thì KeyCode = 0 rồi SetFocus.

 

[NguyenthiH]

Cám ơn Thầy ạ!!

 

[NguyenthiH]

Em chỉ làm được nếu có Msgbox thì enter và ngay1 focus, nhưng không có báo lỗi thì textbox sp1 chưa focus ạ, mong Thầy chỉ giáo. Em "Ngu lâu khó đào tạo" lắm Thầy ơi.

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

 

[batman1]

Em chỉ làm được nếu có Msgbox thì enter và ngay1 focus, nhưng không có báo lỗi thì textbox sp1 chưa focus ạ, mong Thầy chỉ giáo. Em "Ngu lâu khó đào tạo" lắm Thầy ơi.

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

[

Kiểm tra nếu thấy KeyCode = 13 thì làm việc. Nếu có lỗi thì KeyCode = 0 rồi SetFocus.

Làm việc ám chỉ toàn bộ cái tôi ghi trong AfteUpdate chứ không phải gọi GiDo. Cái tôi hỏi bạn, tức cái ghi trong AfteUpdate, làm gì có gọi GiDo??? Tôi có dùng GiDo bao giờ đâu? Tùy trả lời ai mà dùng chính xác nhé.

Nếu có lỗi thì KeyCode = 0 có nghĩa là chỉ sau hoặc trước MsgBox mới có KeyCode = 0.

Nếu cố tình dùng GiDo thì chỉ cần suy nghĩ lôgíc. Tôi không nói là cứ nhấn Enter là phải KeyCode = 0. Enter chỉ là đk thực hiện code. Còn khi thực hiện code mà phát hiện ra lỗi thì mới KeyCode = 0.

Nói ngắn gọn thì thiết lập KeyCode = 0 khi và chỉ khi muốn giữ Focus ở lại TextBox hiện hành.

Tôi đã ghi rất chính xác. Chỉ cần suy nghĩ lôgíc.

 

[batman1]

Em "Ngu lâu khó đào tạo" lắm Thầy ơi.

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?

 

[NguyenthiH]

Em vẫn không hiểu ý Thầy.
Mò hoài không làm được. Không hiểu lo6gic làm sao.
Thầy chỉ em với.

Bài đã được tự động gộp: 5/8/19

Thì trong Sub ngay1_AfterUpdate () thì chạy GiDo ngay1 mà Thầy.

 

[ongke0711]

Giải quyết bài toán Setfocus, em sửa cái hàm GiDo của anh Vetmini lại chút rồi dùng ở sự kiện On Exit.

- Sửa Sub thành Function và trả về giá trị True/False

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 Function

- Gọi trong event Exit:

Private Sub ngay1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If GiDo(ngay1) = False Then
        Cancel = True
    End If
End Sub

Em test lại xem.

 

[NguyenthiH]

Cám ơn anh @ongke0711 nhiều!
Em Test thấy được rồi anh.

 

[batman1]

Em vẫn không hiểu ý Thầy.
Mò hoài không làm được. Không hiểu lo6gic làm sao.
Thầy chỉ em với.

Bài đã được tự động gộp: 5/8/19

Thì trong Sub ngay1_AfterUpdate () thì chạy GiDo ngay1 mà Thầy.

Chạ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 Sub

Bạn nhìn code trên có chỗ nào có GiDo không?

Chuyển sang KeyDown + KeyCode = 0 thì là

Private 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 Sub

Thực ra tôi viết quá đà. Chỉ cần KeyCode = 0 mà không SetFocus gì cả. KeyCode = 0 tức "rút lại", xí xóa, coi như phím "nọ" đã không được nhấn, tức trở lại trạng thái trước khi nhấn phím "nọ". Tức focus đang ở TextBox hiện hành thì nó vẫn ở TextBox hiện hành. Thế thôi. Cần gì SetFocus nữa.

 

[ongke0711]

Dùng Keycode = 0 cũng được em phải suy nghĩ logic như anh batman1 đã nói rồi.

Private 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

(Viết được vài câu thì anh batman1 đã trả lời rồi nên thôi... )

 

[NguyenthiH]

Cám ơn Thầy @batman1 nhiều ạ, thông cảm em "ngu" quá.

 

[batman1]

Cám ơn Thầy @batman1 nhiều ạ, thông cảm em "ngu" quá.

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ì.

 

[HeSanbi]

Bạn thử đoạn code của tôi xem có giúp gì được bạn không

Cách gõ:
- Nếu gõ ký tự đầu mà lớn hơn 3 thì sẽ chuyển sang gõ tháng
- Nếu gõ ký tự đầu mà bằng 3 thì chỉ có thể gõ thêm 0 đến 1
- Nếu gõ 3 và x số lớn hơn 1 gõ 2 lần thì sẽ thành 03/0x/20
- Tương tự gõ tháng cũng ràng buộc theo giới hạn tháng
- Nếu gõ xong tháng thì sẽ tự động điền thêm 2 ký tự YY trong YYYY, nếu muốn điền số khác thì gõ Backspace gõ lại tháng, rồi tiếp tục gõ đủ năm YYYY. (Dự phòng cho trường hợp gõ tháng bị sai)
- Nếu gõ Delete thì xóa tất cả ký tự.

Code không cần đến MsgBox để thông báo, vì code đã được tối ưu.

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

 

[NguyenthiH]

Em có thử code của anh @HeSanbi thì thấy cũng hay. Nhưng vì chưa có code kiểm tra tháng 2 và tháng chẵn lẻ nên còn lỗi.Ví dụ gõ 290219hay 310619.vv..

 

[VetMini]

Từ đầu tôi đã cố gắng dẫn bạn về cái nguyên tắc code phải là 1 hàm và nhận TexBox vào như một tham.
Lý do:
Một Forrm rất có thể có nhiều ô để gõ ngày tháng. Chả nhẽ mỗi ô phải lặp lại một đống code để dùng riêng cho nó.

 

[batman1]

Em có thử code của anh @HeSanbi thì thấy cũng hay. Nhưng vì chưa có code kiểm tra tháng 2 và tháng chẵn lẻ nên còn lỗi.Ví dụ gõ 290219hay 310619.vv..

Tô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.
Vậy tôi dừng ở đây.

 

[HeSanbi]

Bạn thử lại:

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