|
Public Function mSSN(KeyAscii As Integer, PreviousText As String) As String
If Not (IsNumber(KeyAscii)) And KeyAscii <> vbKeyBack Then mSSN = Trim(PreviousText) KeyAscii = 0 ElseIf Len(Trim(PreviousText)) > 10 Then If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) KeyAscii = 0 Else Select Case Len(Trim(PreviousText)) Case 0, 1 If KeyAscii = vbKeyBack Then mSSN = "" KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 2 If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), 1) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & Chr(KeyAscii) & "-" KeyAscii = 0 Case 3 If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), 2) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & "-" & Chr(KeyAscii) KeyAscii = 0 Case 4 If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), 2) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 5 If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), 4) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & Chr(KeyAscii) & "-" KeyAscii = 0 Case 6 If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), 5) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & "-" & Chr(KeyAscii) KeyAscii = 0 Case 7 If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), 5) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case Else If KeyAscii = vbKeyBack Then mSSN = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mSSN = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 End Select End If End Function Public Function mZip(KeyAscii As Integer, PreviousText As String) As String If Not (IsNumber(KeyAscii)) And KeyAscii <> vbKeyBack Then mZip = Trim(PreviousText) KeyAscii = 0 Exit Function ElseIf Len(Trim(PreviousText)) > 9 Then If KeyAscii = vbKeyBack Then mZip = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mZip = Trim(PreviousText) KeyAscii = 0 Exit Function End If Select Case Len(Trim(PreviousText)) Case 0, 1 If KeyAscii = vbKeyBack Then mZip = "" KeyAscii = 0 Exit Function End If mZip = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 2, 3, 4, 6, 8, 9 If KeyAscii = vbKeyBack Then mZip = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mZip = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 5 If KeyAscii = vbKeyBack Then mZip = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mZip = Trim(PreviousText) & "-" & Chr(KeyAscii) KeyAscii = 0 Case 7 If KeyAscii = vbKeyBack Then mZip = Left(Trim(PreviousText), 5) KeyAscii = 0 Exit Function End If mZip = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 End Select End Function Public Function mPhone(KeyAscii As Integer, PreviousText As String) As String If Not (IsNumber(KeyAscii)) And KeyAscii <> vbKeyBack Then mPhone = Trim(PreviousText) KeyAscii = 0 Exit Function ElseIf Len(Trim(PreviousText)) > 13 Then If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) KeyAscii = 0 Exit Function End If Select Case Len(Trim(PreviousText)) Case 0 If KeyAscii = vbKeyBack Then KeyAscii = 0 Exit Function End If mPhone = "(" & Chr(KeyAscii) KeyAscii = 0 Case 1, 2 If KeyAscii = vbKeyBack Then mPhone = "" KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 3 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), 2) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & Chr(KeyAscii) & ")-" KeyAscii = 0 Case 4 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), 3) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & ")-" & Chr(KeyAscii) KeyAscii = 0 Case 5 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), 3) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & "-" & Chr(KeyAscii) KeyAscii = 0 Case 6 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), 3) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 7 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 8 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & Chr(KeyAscii) & "-" KeyAscii = 0 Case 9 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & "-" & Chr(KeyAscii) KeyAscii = 0 Case 10 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), 8) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 Case 11, 12, 13 If KeyAscii = vbKeyBack Then mPhone = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mPhone = Trim(PreviousText) & Chr(KeyAscii) KeyAscii = 0 End Select End Function Public Function mNumber(KeyAscii As Integer) As Integer mNumber = IIf((IsNumber(KeyAscii)), KeyAscii, 0) End Function Public Function mAlpha(KeyAscii As Integer) As Integer mAlpha = IIf((IsAlpha(KeyAscii)), KeyAscii, 0) End Function Public Function mShortDate(ByRef KeyAscii As Integer, PreviousText As String) As String If (Not (IsNumber(KeyAscii))) And KeyAscii <> vbKeyBack Then 'invalid keystroke mShortDate = Trim(PreviousText) KeyAscii = 0 ElseIf Len(Trim(PreviousText)) > 9 Then If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mShortDate = Trim(PreviousText) KeyAscii = 0 Else 'Keystroke ok Select Case Len(Trim(PreviousText)) Case 0 'nothing has been typed yet If KeyAscii = vbKeyBack Then KeyAscii = 0 Exit Function End If If KeyAscii < 50 Then 'month could be 01 - 12 mShortDate = Chr(KeyAscii) KeyAscii = 0 Else mShortDate = "0" & Chr(KeyAscii) & "/" 'month must be 02 - 09 KeyAscii = 0 End If Case 1 'first character must be 0 or 1 If KeyAscii = vbKeyBack Then mShortDate = "" KeyAscii = 0 Exit Function End If If Val(Trim(PreviousText)) = 1 Then If KeyAscii > 50 Then 'keystroke cant be > 2 mShortDate = Trim(PreviousText) KeyAscii = 0 Else 'keystroke must be either 1 or 2 mShortDate = Trim(PreviousText) & Chr(KeyAscii) & "/" KeyAscii = 0 End If Else 'first character must be 0 If KeyAscii = 48 Then 'month cant be 00 mShortDate = Trim(PreviousText) KeyAscii = 0 Else 'month must be 01 - 09 mShortDate = Trim(PreviousText) & Chr(KeyAscii) & "/" KeyAscii = 0 End If End If Case 2 'something's wrong If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), 1) KeyAscii = 0 Exit Function End If mShortDate = mShortDate(KeyAscii, Trim(PreviousText) & "/") KeyAscii = 0 Exit Function Case 3 'month is already there If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), 1) KeyAscii = 0 Exit Function End If If IsDayDone(Val(Left(Trim(PreviousText), 2)), Val(Chr(KeyAscii))) Then mShortDate = Trim(PreviousText) & "0" & Trim(Str(Chr(KeyAscii))) & "/" Else mShortDate = Trim(PreviousText) & Trim(Str(Chr(KeyAscii))) End If KeyAscii = 0 Exit Function Case 4 'month is already there and day's first character must be 0,1,2,3 If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), 3) KeyAscii = 0 Exit Function End If If IsDayOK(Left(Trim(PreviousText), 2), Mid(Trim(PreviousText), 4, 1) & Trim(Chr(KeyAscii))) Then mShortDate = Trim(PreviousText) & Trim(Str(Chr(KeyAscii))) & "/" Else mShortDate = Trim(PreviousText) End If KeyAscii = 0 Exit Function Case 5 'something's wrong If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), 4) KeyAscii = 0 Exit Function End If mShortDate = mShortDate(KeyAscii, PreviousText & "/") KeyAscii = 0 Exit Function Case 6 'month and day is already there If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), 4) KeyAscii = 0 Exit Function End If mShortDate = Trim(PreviousText) & Trim(Chr(KeyAscii)) KeyAscii = 0 Case 7, 8 If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If mShortDate = Trim(PreviousText) & Trim(Chr(KeyAscii)) KeyAscii = 0 Case 9 If KeyAscii = vbKeyBack Then mShortDate = Left(Trim(PreviousText), Len(Trim(PreviousText)) - 1) KeyAscii = 0 Exit Function End If If IsYearOK(Val(Left(Trim(PreviousText), 2)), (Val(Mid(Trim(PreviousText), 4, 2))), (Mid(Trim(PreviousText), 7, 3)) * 10 + Val(Chr(KeyAscii))) Then mShortDate = Trim(PreviousText) & Trim(Chr(KeyAscii)) Else mShortDate = Trim(PreviousText) End If KeyAscii = 0 End Select End If End Function Public Function mMedDate(ByRef KeyAscii As Integer, PreviousText As String) As String If (Not IsNumber(KeyAscii)) And (Not IsAlpha(KeyAscii)) And KeyAscii <> vbKeyBack Then mMedDate = PreviousText KeyAscii = 0 Exit Function End If Select Case Len(PreviousText) Case 0 If (KeyAscii = vbKeyBack) Or (Not IsAlpha(KeyAscii)) Then mMedDate = "" KeyAscii = 0 Exit Function End If mMedDate = FirstLetter(KeyAscii) KeyAscii = 0 Case 1 If (KeyAscii = vbKeyBack) Or (Not IsAlpha(KeyAscii)) Then mMedDate = Trim(PreviousText) KeyAscii = 0 Exit Function End If If Len(Trim(FirstLetter(Asc(Left(Trim(PreviousText), 1))))) > 1 Then mMedDate = FirstLetter(KeyAscii) KeyAscii = 0 Else mMedDate = SecondLetter(Asc(Trim(PreviousText)), KeyAscii) KeyAscii = 0 End If Case 2 If (KeyAscii = vbKeyBack) Or (Not IsAlpha(KeyAscii)) Then mMedDate = Trim(Left(PreviousText, 2)) KeyAscii = 0 Exit Function End If If Len(Trim(FirstLetter(Asc(Left(Trim(PreviousText), 1))))) > 1 Then mMedDate = FirstLetter(Asc(Left(Trim(PreviousText), 1))) KeyAscii = 0 ElseIf Len(Trim(SecondLetter(Asc(Left(PreviousText, 1)), Asc(Mid(PreviousText, 2, 1))))) > 2 Then mMedDate = SecondLetter(Asc(Trim(PreviousText)), Asc(Mid(PreviousText, 2, 1))) KeyAscii = 0 Else mMedDate = ThirdLetter(Trim(PreviousText), KeyAscii) KeyAscii = 0 End If Case 3 If (KeyAscii = vbKeyBack) Or (Not IsAlpha(KeyAscii)) Then mMedDate = Trim(Left(PreviousText, 3)) KeyAscii = 0 Exit Function End If If Len(Trim(FirstLetter(Asc(Left(Trim(PreviousText), 1))))) > 1 Then mMedDate = FirstLetter(Asc(Left(Trim(PreviousText), 1))) KeyAscii = 0 ElseIf Len(Trim(SecondLetter(Asc(Left(PreviousText, 1)), Asc(Mid(PreviousText, 2, 1))))) > 2 Then mMedDate = SecondLetter(Asc(Trim(PreviousText)), Asc(Mid(PreviousText, 2, 1))) KeyAscii = 0 ElseIf Len(ThirdLetter(Mid(Trim(PreviousText), 1, 2), Asc(Mid(Trim(PreviousText), 3, 1)))) > 3 Then mMedDate = ThirdLetter(Mid(Trim(PreviousText), 1, 2), Asc(Mid(Trim(PreviousText), 3, 1))) KeyAscii = 0 Else mMedDate = Trim(PreviousText) & " " KeyAscii = 0 End If Case 4 If (KeyAscii = vbKeyBack) Or (Not IsNumber(KeyAscii)) Then mMedDate = Left(PreviousText, 4) KeyAscii = 0 Exit Function End If If IsDayDone(Month(PreviousText & "1, 1999"), Val(Chr(KeyAscii))) Then mMedDate = PreviousText & "0" & Trim(Chr(KeyAscii)) & ", " KeyAscii = 0 Else mMedDate = PreviousText & Trim(Chr(KeyAscii)) KeyAscii = 0 End If Case 5 If (KeyAscii = vbKeyBack) Or (Not IsNumber(KeyAscii)) Then mMedDate = Trim(Left(PreviousText, 5)) KeyAscii = 0 Exit Function End If If IsDayOK(Month(Left(PreviousText, 3) & " 1, 1999"), Val(Mid(Trim(PreviousText), 5, 1) & Trim(Chr(KeyAscii)))) Then mMedDate = Trim(PreviousText) & Trim(Str(Chr(KeyAscii))) & ", " KeyAscii = 0 Else mMedDate = Trim(PreviousText) KeyAscii = 0 End If End Select End Function '-------------------------------------Pr ' ivate functions------------------------- ' -------------------------------- Private Function IsNumber(KeyAscii As Integer) As Boolean IsNumber = (KeyAscii < 48 Or KeyAscii > 57) End Function Private Function IsAlpha(KeyAscii As Integer) As Boolean IsAlpha = ((KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122)) End Function Private Function IsDayDone(intMonth As Integer, intDay As Integer) As Boolean Select Case intMonth Case 1, 3, 5, 7, 8, 10, 12 If intDay > 3 Then IsDayDone = True Case 4, 6, 9, 11 If intDay > 3 Then IsDayDone = True Case 2 If intDay > 2 Then IsDayDone = True End Select End Function Private Function IsDayOK(intMonth As Integer, intDay As Integer) As Boolean Select Case intMonth Case 1, 3, 5, 7, 8, 10, 12 If intDay < 32 Then IsDayOK = True Case 4, 6, 9, 11 If intDay < 31 Then IsDayOK = True Case 2 If intDay < 30 Then IsDayOK = True End Select End Function Private Function IsYearOK(intMonth As Integer, intDay As Integer, intYear As Integer) As Boolean If intMonth = 2 And intDay = 29 Then If intYear / 100 = Int(intYear / 100) Then IsYearOK = (intYear / 400 = Int(intYear / 400) Else IsYearOK = (intYear / 4 = Int(intYear / 4) End If Else IsYearOK = True End If End Function Private Function FirstLetter(intChar As Integer) As String Select Case Asc(UCase(Chr(intChar))) Case 70 FirstLetter = "Feb " Case 83 FirstLetter = "Sep " Case 79 FirstLetter = "Oct " Case 78 FirstLetter = "Nov " Case 68 FirstLetter = "Dec " Case Else If UCase(Chr(intChar)) = "A" Or UCase(Chr(intChar)) = "J" Or UCase(Chr(intChar)) = "M" Then FirstLetter = Trim(UCase(Chr(intChar))) Else FirstLetter = "" End If End Select End Function Private Function SecondLetter(intFirstChar As Integer, intChar As Integer) As String If intFirstChar = 74 Then 'J If UCase(Chr(intChar)) = "A" Then SecondLetter = "Jan " ElseIf UCase(Chr(intChar)) = "U" Then SecondLetter = "Ju" Else SecondLetter = "J" End If ElseIf intFirstChar = 65 Then 'A If UCase(Chr(intChar)) = "P" Then SecondLetter = "Apr " ElseIf UCase(Chr(intChar)) = "U" Then SecondLetter = "Aug " Else SecondLetter = "A" End If ElseIf intFirstChar = 77 Then 'M If UCase(Chr(intChar)) = "A" Then SecondLetter = "Ma" Else SecondLetter = "M" End If Else SecondLetter = Trim(UCase(Chr(intFirstChar))) End If End Function Private Function ThirdLetter(strFirstChars As String, intChar As Integer) As String If Trim(strFirstChars) = "Ju" Then If UCase(Chr(intChar)) = "L" Then 'july ThirdLetter = "Jul " ElseIf UCase(Chr(intChar)) = "N" Then 'june ThirdLetter = "Jun " Else ThirdLetter = "Ju" End If ElseIf Trim(strFirstChars) = "Ma" Then If UCase(Chr(intChar)) = "R" Then 'March ThirdLetter = "Mar " ElseIf UCase(Chr(intChar)) = "Y" Then 'May ThirdLetter = "May " Else ThirdLetter = "Ma" End If Else ThirdLetter = Trim(strFirstChars) End If End Function |