按钮验证textbox内长度为15位或18位数字,相当于身份证的判断,求代码
private sub text1_lostfocus() if trim(text1。text)15 or len(trim(text1。text)<>18 then msgbox "请输入15位或18位身份证号!",48,"提示" text1。 setfocus exit sub end if end ifend sub==============================================='直接判断是否正确Private Function CheckCode(sCode As String) As Boolean Dim S1To17 As String, S...全部
private sub text1_lostfocus() if trim(text1。text)15 or len(trim(text1。text)<>18 then msgbox "请输入15位或18位身份证号!",48,"提示" text1。
setfocus exit sub end if end ifend sub==============================================='直接判断是否正确Private Function CheckCode(sCode As String) As Boolean Dim S1To17 As String, S18 As String S1To17 = Mid$(sCode, 1, 17) S18 = UCase$(Mid$(sCode, 18, 1)) If retCheckSum(S1To17) = S18 Then CheckCode = True End IfEnd Function'根据前17位生成第18位校验位Private Function retCheckSum(sNum As String) As String Dim nSum As Long, cID As String, CheckNumber As String cID = sNum nSum = Mid$(cID, 1, 1) * 7 nSum = nSum Mid$(cID, 2, 1) * 9 nSum = nSum Mid$(cID, 3, 1) * 10 nSum = nSum Mid$(cID, 4, 1) * 5 nSum = nSum Mid$(cID, 5, 1) * 8 nSum = nSum Mid$(cID, 6, 1) * 4 nSum = nSum Mid$(cID, 7, 1) * 2 nSum = nSum Mid$(cID, 8, 1) * 1 nSum = nSum Mid$(cID, 9, 1) * 6 nSum = nSum Mid$(cID, 10, 1) * 3 nSum = nSum Mid$(cID, 11, 1) * 7 nSum = nSum Mid$(cID, 12, 1) * 9 nSum = nSum Mid$(cID, 13, 1) * 10 nSum = nSum Mid$(cID, 14, 1) * 5 nSum = nSum Mid$(cID, 15, 1) * 8 nSum = nSum Mid$(cID, 16, 1) * 4 nSum = nSum Mid$(cID, 17, 1) * 2 CheckNumber = 12 - nSum Mod 11 Select Case CheckNumber Case 10 retCheckSum = "X" Case 11 retCheckSum = "0" Case 12 retCheckSum = "1" Case Else retCheckSum = CheckNumber End SelectEnd Function。
收起