MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Erro de Compilação Variável não definida - FUNCTION busca_txtCEP()

    Compartilhe

    Marcio75
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1
    Registrado : 12/01/2014

    Erro de Compilação Variável não definida - FUNCTION busca_txtCEP()

    Mensagem  Marcio75 em Ter 11 Mar 2014, 17:01

    Pessoal,

    Preciso de ajuda pra resolver isso. Estou há alguns dias neste projeto e não consigo resolver este de erro de compilação.

    Segue o código todo:


    Option Explicit

    Const colCodFor As Integer = 1
    Const colSituacao As Integer = 2
    Const colRazao As Integer = 3
    Const colAbertura As Integer = 4
    Const colEncerramento As Integer = 5
    Const colFantasia As Integer = 6
    Const colGrupoFor As Integer = 7
    Const colContato As Integer = 8
    Const colCargoContato As Integer = 9
    Const colCNPJ As Integer = 10
    Const colIE As Integer = 11
    Const colCPF As Integer = 12
    Const colRG As Integer = 13
    Const colCEP As String = 14
    Const colEnd As Integer = 15
    Const colNum As Integer = 16
    Const colBairro As Integer = 17
    Const colCidade As Integer = 18
    Const colUF As Integer = 19
    Const colFone1 As Integer = 20
    Const colFone2 As Integer = 21
    Const colEmail As Integer = 22
    Const colObs As Integer = 23
    Const indiceMinimo As Byte = 2
    Const corDisabledTextBox As Long = -2147483633
    Const corEnabledTextBox As Long = -2147483643

    Private wsCadastro As Worksheet
    Private indiceRegistro As Long

    Private Sub btnPesquisar_Click()
    frmPesquisaFornecedor.Show
    End Sub

    Private Sub btnSair_Click()
    Unload Me
    End Sub

    Private Function PegaProximoId() As Long
       Dim rangeIds As Range
       'pega o range que se refere a toda a coluna do código (id)
       Set rangeIds = wsCadastro.Range(wsCadastro.Cells(indiceMinimo, colCodFor), wsCadastro.Cells(wsCadastro.UsedRange.Rows.Count, colCodFor))
       PegaProximoId = WorksheetFunction.Max(rangeIds) + 1
    End Function
    Private Sub AtualizaRegistroCorrente()
       lblNavigator.Caption = indiceRegistro - 1 & " de " & wsCadastro.UsedRange.Rows.Count - 1
    End Sub
    Public Sub CarregaRegistroPorIndice(ByVal indice As Long)
    'carrega os dados do registro baseado no índice
       indiceRegistro = indice

       Call CarregaRegistro
    End Sub

    Private Sub optAlterar_Click()
    If txtCodFor.Text <> vbNullString And txtCodFor.Text <> "" Then
           Call HabilitaControles
           Call DesabilitaBotoesAlteracao
           btnCancelar.Visible = True
           
           'dá o foco ao primeiro controle de dados
           txtRazao.SetFocus
       Else
           lblMensagem.Caption = "Não há registro a ser alterado"
       End If
    End Sub

    Private Sub BtnAnterior_Click()
     If indiceRegistro > indiceMinimo Then
           indiceRegistro = indiceRegistro - 1
       End If
       If indiceRegistro > 1 Then
           Call CarregaRegistro
       End If
    End Sub

    Private Sub btnCancelar_Click()
    btnCancelar.Enabled = False
           Call DesabilitaControles
           
           lblMensagem.Caption = ""
           
           If optNovo.Value Then
               Call CarregaDadosInicial
           End If
       Call HabilitaBotoesAlteracao
           
    End Sub
    Private Sub btnConfirmar_Click()
    Dim proximoId As Long

       'Altera
       If optAlterar.Value Then
           Call SalvaRegistro(CLng(txtCodFor.Text), indiceRegistro)
           lblMensagem.Caption = "Registro salvo com sucesso"
       End If
       'Novo
       If optNovo.Value Then
           proximoId = PegaProximoId
           'pega a próxima linha
           Dim proximoIndice As Long
           proximoIndice = wsCadastro.UsedRange.Rows.Count + 1
           Call SalvaRegistro(proximoId, proximoIndice)
           txtCodFor = proximoId
           lblMensagem.Caption = "Registro salvo com sucesso"
       End If
       'Excluir
       If optExcluir.Value Then
           Dim result As VbMsgBoxResult
           result = MsgBox("Deseja excluir o Fornecedor: " & txtRazao.Text & " ?", vbYesNo, "Confirmação")

           If result = vbYes Then
               wsCadastro.Range(wsCadastro.Cells(indiceRegistro, colCodFor), wsCadastro.Cells(indiceRegistro, colCodFor)).EntireRow.Delete
               Call CarregaDadosInicial
               lblMensagem.Caption = "Registro excluído com sucesso"
           End If
       End If

       Call HabilitaBotoesAlteracao
       Call DesabilitaControles
    End Sub

    Private Sub BtnPrimeiro_Click()
    indiceRegistro = indiceMinimo
       If indiceRegistro > 1 Then
           Call CarregaRegistro
       End If
    End Sub

    Private Sub BtnProximo_Click()
    If indiceRegistro < wsCadastro.UsedRange.Rows.Count Then
           indiceRegistro = indiceRegistro + 1
       End If
       If indiceRegistro > 1 Then
           Call CarregaRegistro
       End If
    End Sub

    Private Sub BtnUltimo_Click()
    indiceRegistro = wsCadastro.UsedRange.Rows.Count
       If indiceRegistro > 1 Then
           Call CarregaRegistro
       End If
    End Sub

    Private Sub optExcluir_Click()
    If txtCodFor.Text <> vbNullString And txtCodFor.Text <> "" Then
           Call DesabilitaBotoesAlteracao
           lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo"
       Else
           lblMensagem.Caption = "Não há registro a ser excluído"
       End If
    End Sub

    Private Sub optNovo_Click()
    Call LimpaControles
       Call HabilitaControles
       Call DesabilitaBotoesAlteracao
       'dá o foco ao primeiro controle de dados
       txtRazao.SetFocus
       
    End Sub

    Private Sub txtEncerramento_Change()
    'Formata : dd/mm/aa
       If Len(txtEncerramento) = 2 Or Len(txtEncerramento) = 5 Then
           txtEncerramento.Text = txtEncerramento.Text & "/"
           SendKeys "{End}", True
       End If
    End Sub

    Private Sub txtCPF_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
       Select Case KeyAscii
           Case 8, 48 To 57
                   Me.txtCPF.MaxLength = 14  ' Quantidade máxima de caracteres no textbox CNPJ
                   If Len(txtCPF) = 3 Then txtCPF = txtCPF + "."
                   If Len(txtCPF) = 7 Then txtCPF = txtCPF + "."
                   If Len(txtCPF) = 11 Then txtCPF = txtCPF + "-"
           Case Else
               KeyAscii = 0
       End Select
    End Sub
    Private Sub txtCNPJ_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
       Select Case KeyAscii
           Case 8, 48 To 57
                   Me.txtCNPJ.MaxLength = 18  ' Quantidade máxima de caracteres no textbox CNPJ
                   If Len(txtCNPJ) = 2 Then txtCNPJ = txtCNPJ + "."
                   If Len(txtCNPJ) = 6 Then txtCNPJ = txtCNPJ + "."
                   If Len(txtCNPJ) = 10 Then txtCNPJ = txtCNPJ + "/"
                   If Len(txtCNPJ) = 15 Then txtCNPJ = txtCNPJ + "-"
           Case Else
               KeyAscii = 0
       End Select
    End Sub

    Private Sub txtIE_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
       Select Case KeyAscii
           Case 8, 48 To 57
                   Me.txtIE.MaxLength = 12  ' Quantidade máxima de caracteres no textbox IE
                   If Len(txtIE) = 2 Then txtIE = txtIE + "."
                   If Len(txtIE) = 6 Then txtIE = txtIE + "."
                   If Len(txtIE) = 10 Then txtIE = txtIE + "-"
           Case Else
               KeyAscii = 0
       End Select
    End Sub

    Private Sub txtFone1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Len(txtFone1) = 0 Then
    txtFone1.Text = "("
    End If
    If Len(txtFone1) = 3 Then
    txtFone1.Text = txtFone1 & ") "
    End If
    If Len(txtFone1) = 9 Then
    txtFone1.Text = txtFone1 & " - "
    End If
    End Sub
    Private Sub txtFone2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Len(txtFone2) = 0 Then
    txtFone2.Text = "("
    End If
    If Len(txtFone2) = 3 Then
    txtFone2.Text = txtFone2 & ") "
    End If
    If Len(txtFone2) = 10 Then
    txtFone2.Text = txtFone2 & " - "
    End If
    End Sub

    Private Sub txtAbertura_Change()
    'Formata : dd/mm/aa
       If Len(txtAbertura) = 2 Or Len(txtAbertura) = 5 Then
           txtAbertura.Text = txtAbertura.Text & "/"
           SendKeys "{End}", True
       End If
    End Sub


    Private Sub UserForm_Initialize()
       Set wsCadastro = ThisWorkbook.Worksheets("Fornecedor")
       Call HabilitaBotoesAlteracao
       Call CarregaDadosInicial
       Call DesabilitaControles
       txtRazao.SetFocus
    End Sub

    Private Sub CarregaDadosInicial()
       indiceRegistro = 2
       Call CarregaRegistro
       
       lblMensagem.Caption = ""
       
    End Sub

    Private Sub CarregaRegistro()
    'carrega os dados do primeiro registro
       With wsCadastro
           If Not IsEmpty(.Cells(indiceRegistro, colCodFor)) Then
               Me.txtCodFor.Text = .Cells(indiceRegistro, colCodFor).Value
               Me.txtRazao.Text = .Cells(indiceRegistro, colRazao).Value
               Me.txtAbertura.Text = .Cells(indiceRegistro, colAbertura).Value
               Me.txtFantasia.Text = .Cells(indiceRegistro, colFantasia).Value
               Me.txtGrupoFor.Text = .Cells(indiceRegistro, colGrupoFor).Value
               Me.txtCPF.Text = .Cells(indiceRegistro, colCPF).Value
               Me.txtCNPJ.Text = .Cells(indiceRegistro, colCNPJ).Value
               Me.txtRG.Text = .Cells(indiceRegistro, colRG).Value
               Me.txtContato.Text = .Cells(indiceRegistro, colContato).Value
               Me.txtIE.Text = .Cells(indiceRegistro, colIE).Value
               Me.txtCargoContato.Text = .Cells(indiceRegistro, colCargoContato).Value
               Me.txtCEP.Text = .Cells(indiceRegistro, colCEP).Value
               Me.txtEnd.Text = .Cells(indiceRegistro, colEnd).Value
               Me.txtNum.Text = .Cells(indiceRegistro, colNum).Value
               Me.txtBairro.Text = .Cells(indiceRegistro, colBairro).Value
               Me.txtUF.Text = .Cells(indiceRegistro, colUF).Value
               Me.txtCidade.Text = .Cells(indiceRegistro, colCidade).Value
               Me.txtFone1.Text = .Cells(indiceRegistro, colFone1).Value
               Me.txtFone2.Text = .Cells(indiceRegistro, colFone2).Value
               Me.txtSituacao.Text = .Cells(indiceRegistro, colSituacao).Value
               Me.txtEmail.Text = .Cells(indiceRegistro, colEmail).Value
               Me.txtObs.Text = .Cells(indiceRegistro, colObs).Value
           End If
       End With

       Call AtualizaRegistroCorrente
    End Sub


    Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)
       With wsCadastro
           .Cells(indice, colCodFor).Value = id
           .Cells(indice, colRazao).Value = Me.txtRazao.Text
           .Cells(indice, colAbertura).Value = Format(Me.txtAbertura.Text, "mm/dd/yyyy")
           .Cells(indice, colFantasia).Value = Me.txtFantasia.Text
           .Cells(indice, colGrupoFor).Value = Me.txtGrupoFor.Text
           .Cells(indice, colCPF).Value = Me.txtCPF.Text
           .Cells(indice, colCNPJ).Value = Me.txtCNPJ.Text
           .Cells(indice, colRG).Value = Me.txtRG.Text
           .Cells(indice, colEncerramento).Value = Format(Me.txtEncerramento.Text, "mm/dd/yyyy")
           .Cells(indice, colContato).Value = Me.txtContato.Text
           .Cells(indice, colIE).Value = Me.txtIE.Text
           .Cells(indice, colCargoContato).Value = Me.txtCargoContato.Text
           .Cells(indice, colCEP).Value = Me.txtCEP.Text
           .Cells(indice, colEnd).Value = Me.txtEnd.Text
           .Cells(indice, colNum).Value = Me.txtNum.Text
           .Cells(indice, colBairro).Value = Me.txtBairro.Text
           .Cells(indice, colUF).Value = Me.txtUF.Text
           .Cells(indice, colCidade).Value = Me.txtCidade.Text
           .Cells(indice, colFone1).Value = Me.txtFone1.Text
           .Cells(indice, colFone2).Value = Me.txtFone2.Text
           .Cells(indice, colSituacao).Value = Me.txtSituacao.Text
           .Cells(indice, colEmail).Value = Me.txtEmail.Text
           .Cells(indice, colObs).Value = Me.txtObs.Text
       End With

       Call AtualizaRegistroCorrente
    End Sub

    Public Function ProcuraIndiceRegistroPodId(ByVal id As Long) As Long
       Dim i As Long
       Dim retorno As Long
       Dim encontrado As Boolean

       i = indiceMinimo
       With wsCadastro
           Do While Not IsEmpty(.Cells(i, colCodFor))
               If .Cells(i, colCodFor).Value = id Then
                   retorno = i
                   encontrado = True
                   Exit Do
               End If
               i = i + 1
           Loop
       End With

       'caso não encontre o registro, retorna -1
       If Not encontrado Then
           retorno = -1
       End If

       ProcuraIndiceRegistroPodId = i
    End Function

    Private Sub LimpaControles()
       
       Me.txtCodFor.Text = ""
       Me.txtRazao.Text = ""
       Me.txtAbertura.Text = ""
       Me.txtFantasia.Text = ""
       Me.txtGrupoFor.Text = ""
       Me.txtCPF.Text = ""
       Me.txtCNPJ.Text = ""
       Me.txtRG.Text = ""
       Me.txtEncerramento.Text = ""
       Me.txtContato.Text = ""
       Me.txtIE.Text = ""
       Me.txtCargoContato.Text = ""
       Me.txtCEP.Text = ""
       Me.txtEnd.Text = ""
       Me.txtNum.Text = ""
       Me.txtBairro.Text = ""
       Me.txtUF.Text = ""
       Me.txtCidade.Text = ""
       Me.txtFone1.Text = ""
       Me.txtFone2.Text = ""
       Me.txtSituacao.Text = ""
       Me.txtEmail.Text = ""
       Me.txtObs.Text = ""
       
    End Sub

    Private Sub HabilitaControles()
       
       'Me.txtCodFor.Locked = False
       Me.txtRazao.Locked = False
       Me.txtAbertura.Locked = False
       Me.txtFantasia.Locked = False
       Me.txtGrupoFor.Locked = False
       Me.txtCPF.Locked = False
       Me.txtCNPJ.Locked = False
       Me.txtRG.Locked = False
       Me.txtEncerramento.Locked = False
       Me.txtContato.Locked = False
       Me.txtIE.Locked = False
       Me.txtCargoContato.Locked = False
       Me.txtCEP.Locked = False
       Me.txtEnd.Locked = False
       Me.txtNum.Locked = False
       Me.txtBairro.Locked = False
       Me.txtUF.Locked = False
       Me.txtCidade.Locked = False
       Me.txtFone1.Locked = False
       Me.txtFone2.Locked = False
       Me.txtSituacao.Locked = False
       Me.txtEmail.Locked = False
       Me.txtObs.Locked = False
           
       'Me.txtCodFor.Text = corEnabledTextBox
       Me.txtRazao.BackColor = corEnabledTextBox
       Me.txtAbertura.BackColor = corEnabledTextBox
       Me.txtFantasia.BackColor = corEnabledTextBox
       Me.txtGrupoFor.BackColor = corEnabledTextBox
       Me.txtCPF.BackColor = corEnabledTextBox
       Me.txtCNPJ.BackColor = corEnabledTextBox
       Me.txtRG.BackColor = corEnabledTextBox
       Me.txtEncerramento.BackColor = corEnabledTextBox
       Me.txtContato.BackColor = corEnabledTextBox
       Me.txtIE.BackColor = corEnabledTextBox
       Me.txtCargoContato.BackColor = corEnabledTextBox
       Me.txtCEP.BackColor = corEnabledTextBox
       Me.txtEnd.BackColor = corEnabledTextBox
       Me.txtNum.BackColor = corEnabledTextBox
       Me.txtBairro.BackColor = corEnabledTextBox
       Me.txtUF.BackColor = corEnabledTextBox
       Me.txtCidade.BackColor = corEnabledTextBox
       Me.txtFone1.BackColor = corEnabledTextBox
       Me.txtFone2.BackColor = corEnabledTextBox
       Me.txtSituacao.BackColor = corEnabledTextBox
       Me.txtEmail.BackColor = corEnabledTextBox
       Me.txtObs.BackColor = corEnabledTextBox

     
    End Sub

    Private Sub DesabilitaControles()

       Me.txtCodFor.Locked = True
       Me.txtRazao.Locked = True
       Me.txtAbertura.Locked = True
       Me.txtFantasia.Locked = True
       Me.txtGrupoFor.Locked = True
       Me.txtCPF.Locked = True
       Me.txtCNPJ.Locked = True
       Me.txtRG.Locked = True
       Me.txtEncerramento.Locked = True
       Me.txtContato.Locked = True
       Me.txtIE.Locked = True
       Me.txtCargoContato.Locked = True
       Me.txtCEP.Locked = True
       Me.txtEnd.Locked = True
       Me.txtNum.Locked = True
       Me.txtBairro.Locked = True
       Me.txtUF.Locked = True
       Me.txtCidade.Locked = True
       Me.txtFone1.Locked = True
       Me.txtFone2.Locked = True
       Me.txtSituacao.Locked = True
       Me.txtEmail.Locked = True
       Me.txtObs.Locked = True
       
       'Me.txtCodFor.Text = corDisabledTextBox
       Me.txtRazao.BackColor = corDisabledTextBox
       Me.txtAbertura.BackColor = corDisabledTextBox
       Me.txtFantasia.BackColor = corDisabledTextBox
       Me.txtGrupoFor.BackColor = corDisabledTextBox
       Me.txtCPF.BackColor = corDisabledTextBox
       Me.txtCNPJ.BackColor = corDisabledTextBox
       Me.txtRG.BackColor = corDisabledTextBox
       Me.txtEncerramento.BackColor = corDisabledTextBox
       Me.txtContato.BackColor = corDisabledTextBox
       Me.txtIE.BackColor = corDisabledTextBox
       Me.txtCargoContato.BackColor = corDisabledTextBox
       Me.txtCEP.BackColor = corDisabledTextBox
       Me.txtEnd.BackColor = corDisabledTextBox
       Me.txtNum.BackColor = corDisabledTextBox
       Me.txtBairro.BackColor = corDisabledTextBox
       Me.txtUF.BackColor = corDisabledTextBox
       Me.txtCidade.BackColor = corDisabledTextBox
       Me.txtFone1.BackColor = corDisabledTextBox
       Me.txtFone2.BackColor = corDisabledTextBox
       Me.txtSituacao.BackColor = corDisabledTextBox
       Me.txtEmail.BackColor = corDisabledTextBox
       Me.txtObs.BackColor = corDisabledTextBox
       
    End Sub

    Private Sub DesabilitaBotoesAlteracao()

    'desabilita os botões de alteração
       optAlterar.Enabled = False
       optExcluir.Enabled = False
       optNovo.Enabled = False
             
    End Sub

    Private Sub HabilitaBotoesAlteracao()

    'habilita os botões de alteração
       optAlterar.Enabled = True
       optExcluir.Enabled = True
       optNovo.Enabled = True
       btnConfirmar.Enabled = True
       btnCancelar.Enabled = True
       btnPesquisar.Enabled = True
       
     ' limpa os valores dos controles
       optAlterar.Value = False
       optExcluir.Value = False
       optNovo.Value = False
       
    End Sub
    'CEP
    Private Sub txtCEP_Change()
         
       txtCEP.MaxLength = 9

       'Formata Numero automático ao digitar
       If Len(txtCEP) = 5 Or Len(txtCEP) = 5 Then
           txtCEP.Text = txtCEP.Text & "-"
           SendKeys "{End}", True
       End If
       
    End Sub

    Private Sub txtCEP_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
       'para permitir que apenas números sejam digitados
       If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
           KeyAscii = 0
       End If
    End Sub


    Private Sub VerificartxtCEP()
       '
       ' Exemplo de utilização
       '
       Dim resultado
       Dim Texto As String
       resultado = busca_txtCEP(Me.txtCEP)
       
       Dim i As Integer
       Dim X As String
       
       For i = 0 To 14
           X = X & Chr(13) & resultado(i)
       Next

       Select Case resultado(2)

           Case "0" 'CEP NÃO LOCALIZADO
               Me.lblCepMsg.Caption = Replace(resultado(4), "sucesso - ", "")
               Me.lblCepMsg.Caption = Replace(lblCepMsg.Caption, "%E3", "ã")
               
           Case "1" 'CEP LOCALIZADO
               Me.txtEnd = resultado(12) & " " & resultado(14)
               Me.txtBairro = resultado(10)
               Me.txtCidade = resultado(Cool
               Me.txtUF = resultado(6)

           Case Else
       
       End Select
       
    End Sub

    Private Sub txtCEP_AfterUpdate()
       
       Call VerificartxtCEP
       
    On Error Resume Next
     
      If Not IsNull(Me.txtEnd) Or Not IsNull(Me.txtBairro) Or Not IsNull(Me.txtCidade) Then
     
       Me.txtEnd = Replace(Me.txtEnd, "%E1", "á")
       Me.txtEnd = Replace(Me.txtEnd, "%E2", "â")
       Me.txtEnd = Replace(Me.txtEnd, "%E3", "ã")
       Me.txtEnd = Replace(Me.txtEnd, "%E7", "ç")
       Me.txtEnd = Replace(Me.txtEnd, "%E9", "é")
       Me.txtEnd = Replace(Me.txtEnd, "%EA", "ê")
       Me.txtEnd = Replace(Me.txtEnd, "%ED", "í")
       Me.txtEnd = Replace(Me.txtEnd, "%F3", "ó")
       Me.txtEnd = Replace(Me.txtEnd, "%F4", "ô")
       Me.txtEnd = Replace(Me.txtEnd, "%F5", "õ")
       Me.txtEnd = Replace(Me.txtEnd, "%FA", "ú")
       
       Me.txtBairro = Replace(Me.txtBairro, "%E1", "á")
       Me.txtBairro = Replace(Me.txtBairro, "%E2", "â")
       Me.txtBairro = Replace(Me.txtBairro, "%E3", "ã")
       Me.txtBairro = Replace(Me.txtBairro, "%E7", "ç")
       Me.txtBairro = Replace(Me.txtBairro, "%E9", "é")
       Me.txtBairro = Replace(Me.txtBairro, "%EA", "ê")
       Me.txtBairro = Replace(Me.txtBairro, "%ED", "í")
       Me.txtBairro = Replace(Me.txtBairro, "%F3", "ó")
       Me.txtBairro = Replace(Me.txtBairro, "%F4", "ô")
       Me.txtBairro = Replace(Me.txtBairro, "%F5", "õ")
       Me.txtBairro = Replace(Me.txtBairro, "%FA", "ú")

       Me.txtCidade = Replace(Me.txtCidade, "%E1", "á")
       Me.txtCidade = Replace(Me.txtCidade, "%E2", "â")
       Me.txtCidade = Replace(Me.txtCidade, "%E3", "ã")
       Me.txtCidade = Replace(Me.txtCidade, "%E7", "ç")
       Me.txtCidade = Replace(Me.txtCidade, "%E9", "é")
       Me.txtCidade = Replace(Me.txtCidade, "%EA", "ê")
       Me.txtCidade = Replace(Me.txtCidade, "%ED", "í")
       Me.txtCidade = Replace(Me.txtCidade, "%F3", "ó")
       Me.txtCidade = Replace(Me.txtCidade, "%F4", "ô")
       Me.txtCidade = Replace(Me.txtCidade, "%F5", "õ")
       Me.txtCidade = Replace(Me.txtCidade, "%FA", "ú")

       End If

    End Sub

    Function busca_txtCEP()

       Url = "http://republicavirtual.com.br/web_cep.php?cep=" & txtCEP & "&formato=query_string"

       'TROQUEI ServerXMLHTTP POR XMLHTTP E AGORA FUNCIONA CORRETAMENTE
       'Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
       Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
       
       XMLHTTP.Open "GET", Url, False
       XMLHTTP.Send ""

       xmlhttp_resultado = XMLHTTP.responseText
       
       Set XMLHTTP = Nothing

       arr_resultado = Split(xmlhttp_resultado, "&")

       Dim resultado(7)
           For i = LBound(arr_resultado) To UBound(arr_resultado)
           
               resultado(i) = arr_resultado(i)
           
           Next

           arr = Split(Join(resultado, "="), "=")

       Dim arr_2(14)
       
       For i = LBound(arr) To UBound(arr)
           arr_2(i) = Replace(arr(i), "+", " ")
       Next

       busca_cep = arr_2
       
    End Function

    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12246
    Registrado : 01/03/2011

    Re: Erro de Compilação Variável não definida - FUNCTION busca_txtCEP()

    Mensagem  HARYSOHN em Ter 11 Mar 2014, 22:36

    Um belo código..

    Mas não ajuda na solução do problema se não falar a linha que está dando o erro..

    Cumprimentos.


    .................................................................................
    PILOTO
    الله أكبر Paz, Justiça e Liberdade! الله أكبر
    CLIQUE AQUI E VEJA O VÍDEO >>> BIOMETRIA EM ACCESS

    Iniciando no Access? Então veja esse tópico e também esse


    BUSCA NO FÓRUM - CLIQUE AQUI!!!

    Quando tua dúvida for RESOLVIDA, dê retorno com AGRADECIMENTO a aqueles que gastaram seu tempo em te ajudar.
    Clique no botão Resolvido logo acima do botão Enviar, do lado direito. Todos nós agradecemos.  
    [Você precisa estar registrado e conectado para ver esta imagem.]

      Data/hora atual: Sex 09 Dez 2016, 07:39