Validação PIS/PASEP

obs: É necessário tambem a função removemascara() que está no final do artigo !

Function FF_PISPASEP(Controle)
    Dim WL_NRPISPASEP
    Dim WL_NRSOMA
    Dim WL_NRRESTO
    Dim i
    Dim VL_Numero(10)
   
    FF_PISPASEP = False
   
    WL_NRPISPASEP = RemoveMascara(Controle)

    if trim(WL_NRPISPASEP)="" then
       FF_PISPASEP = True
       exit Function
    End if

    WL_NRPISPASEP = String(11 - Len(WL_NRPISPASEP), "0") + WL_NRPISPASEP
   
    'Preenche Vetor com Valores do Número do CPF
    For i = 1 To 10
        VL_Numero(i) = Mid(WL_NRPISPASEP, i, 1)
    Next

    'Verifica Dígito
    WL_NRSOMA = (VL_Numero(10) * 2) + (VL_Numero(9) * 3) + (VL_Numero(8) * 4) + (VL_Numero(7) * 5) + (VL_Numero(6) * 6) + (VL_Numero(5) * 7) + (VL_Numero(4) * 8) + (VL_Numero(3) * 9) + (VL_Numero(2) * 2) + (VL_Numero(1) * 3)
    WL_NRRESTO = WL_NRSOMA Mod 11
    'Atribui valor para o primerio dígito
    If WL_NRRESTO = 0 Or WL_NRRESTO = 1 Then
       WL_NRRESTO = 0
    Else
       WL_NRRESTO = 11 - WL_NRRESTO
    End If
   
    'Retorna Valor do Dígito.
    If Right(WL_NRPISPASEP, 1) <> WL_NRRESTO Then
       Controle.focus
       If Controle.Mask = "###.#####.##-#" Then 'WF_NRTypeControl = CF_Pis Then
          MsgBox "Número do PIS inválido", vbOKOnly + vbInformation
       Else
          MsgBox "Número do PASEP inválido", vbOKOnly + vbInformation
       End If
       Exit Function
    End If
    FF_PISPASEP = True
   
End Function

Function RemoveMascara(Controle)
Dim wl_string,i

    wl_string=""
    For i = 1 to Len(Controle.value)
        if mid(Controle.Mask,i,1)="9" or mid(Controle.Mask,i,1)="#" then
            wl_string = wl_string & mid(Controle.value,i,1)
        End If
    Next
    RemoveMascara = wl_string

End Function

Esta matéria foi postada originalmente no ASP4Developers por Thiago Machado Souza (site), que na época era "Programador Desbravador, buscando quebrar todas as fronteiras além do horizonte da arte de programar !
www.thiagomachado.com.br". Hoje, vai saber...