MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

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
    avatar
    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12230
    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: Seg 26 Jun 2017, 20:03