设text1用来输入15位身份证,text2用来输出18位身份证,command1按钮开始转换:Private Sub Command1_Click()Dim t As Long, s As StringIf Len(Text1.Text)15 Then
MsgBox "请输入15位身份证号！"
Exit SubEnd IfIf Not IsNumeric(Text1.Text) Then
MsgBox "请输入数字"
Exit SubEnd IfIf Val(Mid(Text1.Text, 9, 2)) > 12 Or Val(Mid(Text1.Text, 9, 2)) = 0 Or _
Val(Mid(Text1.Text, 11, 2)) > 31 Or Val(Mid(Text1.Text, 9, 2)) = 0 Then
MsgBox "身份证格式错误"
Exit SubEnd Ift = (Val(Mid(Text1.Text, 1, 1)) * 7 + Val(Mid(Text1.Text, 2, 1)) * 9 + _
Val(Mid(Text1.Text, 3, 1)) * 10 + Val(Mid(Text1.Text, 4, 1)) * 5 + _
Val(Mid(Text1.Text, 5, 1)) * 8 + Val(Mid(Text1.Text, 6, 1)) * 4 + _
Val(Mid(Text1.Text, 7, 1)) * 6 + Val(Mid(Text1.Text, 8, 1)) * 3 + _
Val(Mid(Text1.Text, 9, 1)) * 7 + Val(Mid(Text1.Text, 10, 1)) * 9 + _
Val(Mid(Text1.Text, 11, 1)) * 10 + Val(Mid(Text1.Text, 12, 1)) * 5 + _
Val(Mid(Text1.Text, 13, 1)) * 8 + Val(Mid(Text1.Text, 14, 1)) * 4 + _
Val(Mid(Text1.Text, 15, 1)) * 2 + 1 * 2 + 9 * 1) Mod 11s = Mid("10X98765432", t + 1, 1)Text2.Text = Mid(Text1.Text, 1, 6) + "19" + Mid(Text1.Text, 7, 9) + sEnd Sub注:这里转换的身份证号都是2000年以前的,估计2000年以后的身份证没有15位的了吧!
|
