USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (ActiveX/Controles/DLL)

Título da Dica:  DEFINIR A UF COM BASE NO CEP INFORMADO
Postada em 27/6/2007 por ¨PCNATIVO         
Option Explicit
Private Function DefineUF(pCEP As String) As String
    pCEP = RetornarNumeros(pCEP)
    Select Case pCEP
    Case "69900000" To "69999999"
        DefineUF = "AC"
    Case "57000000" To "57999999"
        DefineUF = "AL"
    Case "69000000" To "69299999", "69400000" To "69899999"
        DefineUF = "AM"
    Case "68900000" To "68999999"
        DefineUF = "AP"
    Case "40000000" To "48999999"
        DefineUF = "BA"
    Case "60000000" To "63999999"
        DefineUF = "CE"
    Case "70000000" To "72799999", "73000000" To "73699999"
        DefineUF = "DF"
    Case "29000000" To "29999999"
        DefineUF = "ES"
    Case "72800000" To "72999999", "73700000" To "76799999"
        DefineUF = "GO"
    Case "65000000" To "65999999"
        DefineUF = "MA"
    Case "30000000" To "39999999"
        DefineUF = "MG"
    Case "79000000" To "79999999"
        DefineUF = "MS"
    Case "78000000" To "78899999"
        DefineUF = "MT"
    Case "66000000" To "68899999"
        DefineUF = "PA"
    Case "58000000" To "58999999"
        DefineUF = "PB"
    Case "50000000" To "56999999"
        DefineUF = "PE"
    Case "64000000" To "64999999"
        DefineUF = "PI"
    Case "80000000" To "87999999"
        DefineUF = "PR"
    Case "20000000" To "28999999"
        DefineUF = "RJ"
    Case "59000000" To "59999999"
        DefineUF = "RN"
    Case "78900000" To "78999999"
        DefineUF = "RO"
    Case "69300000" To "69399999"
        DefineUF = "RR"
    Case "90000000" To "99999999"
        DefineUF = "RS"
    Case "88000000" To "89999999"
        DefineUF = "SC"
    Case "49000000" To "49999999"
        DefineUF = "SE"
    Case "1000000" To "19999999"
        DefineUF = "SP"
    Case "77000000" To "77999999"
        DefineUF = "TO"
    Case Else
        DefineUF = "CEP INVÁLIDO"
    End Select
End Function
Private Function RetornarNumeros(ByVal iText As String) As String
Dim i As Long, j As String
    For i = 1 To Len(iText)
        If Asc(Mid$(iText, i, 1)) < 48 Or Asc(Mid$(iText, i, 1)) > 57 Then
        Else
            j = j & Mid$(iText, i, 1)
        End If
        RetornarNumeros = j
    Next i
End Function
 


CyberWEB Network Ltda.    © Copyright 2000-2021   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página