Este fórum está sendo desativado

[pasedo]

Boa tarde pessoal, poderiam me ajudar neste form, preciso que ao pesquisar entre dois ceps me retorne a distancia e as horas nos textbox sinalizados em vermelhos por um circulo ai na imagem, grato pela ajuda.

estou enviando pelo dropbox porque o arquivo tem 31mb...segue o link https://www.dropbox.com/s/4xcj62thmceqn ... 2.rar?dl=0

[pasedo]

Bom dia pessoal, não tem jeito essa planilha? Grato

[babdallas]

Tente assim. Só fiz o que você pediu (o código que fiz está no final desta subrotina. Não vi o restante do código.

Código: Selecionar todos

Private Sub CEP2_AfterUpdate()
Call VerificarCEP2

If Not IsNull(Me.Tend2) And Not IsNull(Me.bairro2) And Not IsNull(Me.cidade2) Then

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

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

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

End If

If Me.CEP.Value = vbNullString Then
    VBA.MsgBox "Insira o CEP de origem"
    Me.CEP.SetFocus
Else
    Me.TextBox1.Value = G_DISTANCIA(Me.CEP.Value, Me.CEP2.Value)
End If

End Sub

[pasedo]

Consegui, a distância deu certo e as horas não esta dando certo ...


If Me.CEP.Value = vbNullString Then
VBA.MsgBox "Insira o CEP de origem"
Me.CEP.SetFocus
Else
Me.TextBox1.Value = G_DISTANCIA(Me.CEP.Value, Me.CEP2.Value)
'ACRESCENTEI ESTAS DUAS LINHAS PARA AS HORAS MAS NÃO ESTA DANDO CERTO
Me.TextBox2.Value = G_duracao(Me.CEP.Value, Me.CEP2.Value)
'Me.TextBox2.Text = HrStr(TextBox2.Text)
End If
'USEI ESTA FUNÇÃO PARA CONVERTER AS HORAS DECIMAIS OU NÚMEROS PARA HORAS E MINUTOS, MAS NÃO ESTOU CONSEGUINDO.
Option Explicit

Public Function HrStr(dblHora As Double) As String
'Pega um valor numérico e o converte para Horas/Minutos
'Ex: 123,5 = “123:30”
'Ex: 23,9833333333333 = “23:59”


Dim strHoras As String
Dim strMinutos As String


'Pega as horas (parte inteira)
strHoras = CStr(Fix(dblHora))


'Pega os minutos
strMinutos = Format$(Abs((dblHora - Fix(dblHora)) * 60), "00")


'Verifica se o total de minutos é 60
If strMinutos = "60" Then
strMinutos = "00"
strHoras = CStr(CDbl(strHoras) + 1)
End If


'Concatena os dois
HrStr = strHoras & ":" & strMinutos


End Function
SEGUE A IMAGEM ANEXADA

[pasedo]

Resolvi aqui é só acrescentar esta linha
TextBox2.Text = Application.WorksheetFunction.Text(G_duracao(CEP.Value, CEP2.Value), "[H]:mm:ss")