小白求助！！！

shoupor

Private Sub Worksheet_Change(ByVal T As Range)
    '限定作用域
    On Error Resume Next
    If Application.Intersect(T, Range("H2:H65536")) Is Nothing Or T.Value = "" Then Exit Sub
    '限定身份证号是18位
    If Len(T) <> 18 Then
        Application.EnableEvents = False
        MsgBox "身份证号不是18位，请重新输入"
        T.Select
        Rem T.ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If
    '校验前17位是否为数字/检验第18位校验码是否正确
    arr = Array("7", "9", "10", "5", "8", "4", "2", "1", "6", "3", "7", "9", "10", "5", "8", "4", "2")
    brr = Array("1", "0", "x", "9", "8", "7", "6", "5", "4", "3", "2")
    For h = 1 To 17
        j = Mid(T, h, 1)
        If IsNumeric(j) = False Then
            Application.EnableEvents = False
            MsgBox "您可能输入了非法字符"
            T.Select
            Rem T.ClearContents
            Application.EnableEvents = True
            Exit Sub
        End If
        s = s + j * arr(h - 1)
    Next
    k = s Mod 11
    If Mid(T, 18) <> brr(k) Then
        Application.EnableEvents = False
        MsgBox "校验码不符，请重新输入"
        T.Select
        Rem T.ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If
    '限定出生日期范围为1929.1.1-2000.1.1/消息框提示再次确认出生日期、性别
    d = Format(Mid(T, 7, 8), "0000-00-00")
    xb = Mid(T, 17, 1)
    If d > #1/1/1900# And d < #1/1/2020# Then
          If InStr("13579", xb) > 0 Then
              MsgBox "该同志出生于：" & Format(Mid(T, 7, 8), "0000年00月00日") & "，性别为男，请最后确认一遍"
              Else
              MsgBox "该同志出生于：" & Format(Mid(T, 7, 8), "0000年00月00日") & "，性别为女，请最后确认一遍"
          End If
        Else
        Application.EnableEvents = False
        MsgBox "输入的出生时间可能有误，请重新输入"
        T.Select
        Rem T.clearconcents
        Application.EnableEvents = True
    End If
End Sub
如何让这个效验身份证的代码，在所有工作表中都可以用？
我在thiswordbook里面输入了，没用，把第一行Private Sub Worksheet_Change(ByVal T As Range)改成了Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)也没用。
求大佬帮我改改！！！！！让他能够应用到所有工作表。万分感谢！

liulang0808

建议楼主上传附件吧

shoupor

liulang0808 发表于 2019-12-18 07:25
建议楼主上传附件吧

已上传，我的意思是，这宏在第一个表里生效了，怎样修改，能在所有的表里都有效？？？
请大神帮我改下，谢谢

xyxcc177

好了//////////////

liulang0808

附件内容供参考。。。。。