rem Contribuição de João Santos
rem Validação do NIF

rem Escrever em vba na folha1:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Nvar As Boolean
Dim IsValidContrib As Boolean

'NVar = Format(Range("B12"), "000000000")
If Target.Address = Range("B12").Address Then

    If IsNumeric(Range("B12")) Then 'se não preencher o campo ignora

       Nvar = Module1.IsValidContrib(Format(Range("B12"), "000000000"))

       If Nvar = True Then
       Else 'senão avisa em vermelho
           Range("B12") = "NIF INVÁLIDO"
       End If
    End If
End If

End Sub

rem Agora devemos criar um módulo em VBA e escrever esta função:

Public Function IsValidContrib(ByVal contrib As String) As Boolean

        Dim s As Long
        Dim i, checkDigit As Integer

        IsValidContrib = False
        checkDigit = 0

        If contrib < 10000000 Or contrib > 999999999 Then

            Exit Function
        End If

        If (Mid(contrib, 1, (1)) = 1 Or Mid(contrib, 1, (1)) = 2 Or Mid(contrib, 1, (1)) = 5 Or Mid(contrib, 1, (1)) = 6 Or Mid(contrib, 1, (1)) = 8 Or Mid(contrib, 1, (1)) = 9) Then
        Else
            Exit Function
        End If

        For i = 1 To 8
            checkDigit = checkDigit + (Mid(contrib, i, (1)) * (10 - i))
        Next

        dblDivisao = checkDigit / 11
        s = Int(dblDivisao) * 11
        checkDigit = checkDigit - s

        If (checkDigit = 0 Or checkDigit = 1) Then

            checkDigit = 0
        Else
            checkDigit = 11 - checkDigit
        End If

        If (checkDigit = Mid(contrib, 9, (1))) Then
            IsValidContrib = True
        End If


End Function

rem Função que valida o NIB

rem Escrever em VBA na folha1:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim erro As Integer
Dim IsValidnib As Boolean

'NVar = Format(Range("B12"), "000000000000000000000")
If Target.Address = Range("B12").Address Then

    If IsNumeric(Range("B12")) Then 'se não preencher o campo ignora
       erro = Module1.IsValidnib(Format(Range("B12"), "000000000000000000000"))

       If erro = 0 Then
       ElseIf erro = 1 Then
           Range("B12") = "NIB INVÁLIDO" 'check digit inválido
       ElseIf erro = 2 Then
           Range("B12") = "comprimento do NIB INVÁLIDO"
       ElseIf erro = 3 Then
           Range("B12") = "banco do NIB INVÁLIDO"
       End If
    End If
End If

End Sub

rem A Seguir devemos criar um módulo e escrever o seguinte:

Public Function IsValidnib(ByVal nib As String) As Integer

        Dim s As Long
        Dim i, i2, checkDigit As Integer
        Dim nib_auxiliar As String
        Dim Tabela_pesos(31) As Byte
        Dim Tabela_bancos(40) As Integer

        IsValidnib = 1

        Tabela_pesos(1) = 85
        Tabela_pesos(2) = 57
        Tabela_pesos(3) = 93
        Tabela_pesos(4) = 19
        Tabela_pesos(5) = 31
        Tabela_pesos(6) = 71
        Tabela_pesos(7) = 75
        Tabela_pesos(8) = 56
        Tabela_pesos(9) = 25
        Tabela_pesos(10) = 51
        Tabela_pesos(11) = 73
        Tabela_pesos(12) = 17
        Tabela_pesos(13) = 89
        Tabela_pesos(14) = 38
        Tabela_pesos(15) = 62
        Tabela_pesos(16) = 45
        Tabela_pesos(17) = 53
        Tabela_pesos(18) = 15
        Tabela_pesos(19) = 50
        Tabela_pesos(20) = 5
        Tabela_pesos(21) = 49
        Tabela_pesos(22) = 34
        Tabela_pesos(23) = 81
        Tabela_pesos(24) = 76
        Tabela_pesos(25) = 27
        Tabela_pesos(26) = 90
        Tabela_pesos(27) = 9
        Tabela_pesos(28) = 30
        Tabela_pesos(29) = 3
        Tabela_pesos(30) = 10
        Tabela_pesos(31) = 1

        Tabela_bancos(1) = 7' deve acrescentar os códigos de banco que conheça para validar o banco.
        Tabela_bancos(2) = 10
        Tabela_bancos(3) = 12
        Tabela_bancos(4) = 18
        Tabela_bancos(5) = 32
        Tabela_bancos(6) = 33
        Tabela_bancos(7) = 35
        Tabela_bancos(8) = 36
        Tabela_bancos(9) = 43

        nib_auxiliar = 0
        nib_auxiliar = nib
        i = 1
        checkDigit = 0

        If nib_auxiliar < 1E+17 Or nib_auxiliar > 1E+21 Then

            IsValidnib = 2
            Exit Function
        End If

        s = 0

        For i2 = 1 To 9
            If Mid(nib_auxiliar, 1, (4)) = Tabela_bancos(i2) Then
                 s = 1
            End If
        Next

        If s = 0 Then
            IsValidnib = 3
            Exit Function
        End If

        For i = i To 19
            checkDigit = checkDigit + (Mid(nib_auxiliar, i, (1)) * Tabela_pesos(i + 10))
        Next

        dblDivisao = checkDigit / 97
        s = Int(dblDivisao) * 97
        checkDigit = checkDigit - s
        checkDigit = 98 - checkDigit

        If (checkDigit = Mid(nib_auxiliar, 20, (2))) Then
            IsValidnib = 0
        End If


End Function

rem Para validar o PAN (cartão de crédito e bancário)
rem Escrever na folha1:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Nvar As Boolean
Dim IsValidContrib As Boolean

'NVar = Format(Range("B12"), "000000000")
If Target.Address = Range("B12").Address Then

    If IsNumeric(Range("B12")) Then 'se não preencher o campo ignora

       Nvar = Module1.IsValidPAN(Format(Range("B12"), "0000000000000000"))

       If Nvar = True Then
       Else 'senão avisa em vermelho
           Range("B12") = "CC INVÁLIDO"
       End If
    End If
End If

End Sub

rem A seguir devemos criar um modulo em VBA e escrever:

Public Function IsValidPAN(ByVal PAN As String) As Boolean

        Dim s, s1 As Integer
        Dim i, checkDigit, par, comp As Integer

        IsValidPAN = False
        checkDigit = 0

        If PAN = "" Then
            IsValidPAN = True
            Exit Function
        End If

        If PAN < 100000000000000# Then
            par = 1
            comp = 14

            ElseIf PAN < 1E+15 Then
                par = 0
                comp = 15
            Else
                par = 1
                comp = 16
        End If

        For i = 1 To comp - 1

            If par = 1 Then

                s1 = Mid(PAN, i, (1)) * 2

                If s1 > 9 Then
                    s1 = s1 - 10
                End If

                s = s + (s1)

                If Mid(PAN, i, (1)) > 4 Then
                    s = s + (1)
                End If

                par = 0
            Else
                s = s + Mid(PAN, i, (1))
                par = 1
            End If
        Next

        s1 = s
        s1 = s1 / 10
        s1 = s1 * 10
        s = s - s1

        If s > 0 Then
        s = 10 - s
        End If

        s1 = Mid(PAN, comp, (1))

        If s1 = s Then
            IsValidPAN = True
        End If

End Function