Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
  • Avatar do usuário
Por Wrush
Posts
#11588
Bom Dia!!
Estou com um erro em meu código que não consigo resolver: Estou desenvolvendo uma Agenda telefônica e em um formulário para alterar/excluir um contato, dá o seguinte erro: "Erro 1004: Não foi possível obter a propriedade VlookUP da classe worksheet function". Acredito que o código para exclusão do contato esteja correto pois o mesmo é realmente excluído, porém, após deletar esse contato dá essa mensagem de erro. Abaixo segue o código de exclusão:

Private Sub btnexcluir_Click()

Dim contato As String

linha = 3
contato = frmalterar.cmbcontato

shtdados.Select

Do Until shtdados.Cells(linha, 1) = ""
'condição para localizar o contato
'-----------------------------------------------------------
If shtdados.Cells(linha, 1) = contato Then
shtdados.Cells(linha, 1).Select
Dim resposta As String 'cria a variável resposta
resposta = MsgBox("O registro será excluído. Confirma a exclusão?", vbYesNo) 'cria a mensagem para determinar qual ação será executada

If resposta = vbYes Then ' se a resposta for sim então

'comando para deletar toda a linha
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
ActiveCell.Select

'limpa todos os campos do formulário
With frmalterar

.cmbcontato = ""
.txtendereco = ""
.txtbairro2 = ""
.txtcity = ""
.txtresidencial = ""
.txtcelular = ""
.txtcodigo2 = ""
.txtramal2 = ""
.txtfuncao2 = ""
.txtemail2 = ""
End With
MsgBox ("Registro excluído com sucesso!!!")
End If
Else
End If
linha = linha + 1
Loop
popularnome
End Sub

Logo abaixo, o código da caixa de combinação(evento change para mudança do contato). O trecho em destaque é onde sinaliza o erro 1004 e quando depurado destaca a seguinte mensagem?

Private Sub cmbcontato_Change()

'variaveis para pesquisa
'------------------------------------------------------------------------------------------------------
Dim intervalo As Range
Dim contato As String

'Seleciona a Planilha de dados e determina a variável contato
'-----------------------------------------------------------------------------------------------------
shtdados.Select
contato = frmalterar.cmbcontato

'Seleciona o intervalo de celulas que armazenam os contatos na planilha
'-----------------------------------------------------------------------------------------------------
Set intervalo = Range("A3:J1048576")

'Pesquisa os campos referente ao contato selecionado na caixa de combinação
'-----------------------------------------------------------------------------------------------------
pesquisa0 = Application.WorksheetFunction.VLookup(contato, intervalo, 2, False) 'endereço
pesquisa1 = Application.WorksheetFunction.VLookup(contato, intervalo, 3, False) 'bairro
pesquisa2 = Application.WorksheetFunction.VLookup(contato, intervalo, 4, False) 'cidade
pesquisa3 = Application.WorksheetFunction.VLookup(contato, intervalo, 5, False) 'telefone residencial
pesquisa4 = Application.WorksheetFunction.VLookup(contato, intervalo, 6, False) 'celular
pesquisa5 = Application.WorksheetFunction.VLookup(contato, intervalo, 7, False) 'codigo
pesquisa6 = Application.WorksheetFunction.VLookup(contato, intervalo, 8, False) 'ramal
pesquisa7 = Application.WorksheetFunction.VLookup(contato, intervalo, 9, False) 'função
pesquisa8 = Application.WorksheetFunction.VLookup(contato, intervalo, 10, False) 'E-mail

frmalterar.txtendereco = pesquisa0
frmalterar.txtbairro2 = pesquisa1
frmalterar.txtcity = pesquisa2
frmalterar.txtresidencial = pesquisa3
frmalterar.txtcelular = pesquisa4
frmalterar.txtcodigo2 = pesquisa5
frmalterar.txtramal2 = pesquisa6
frmalterar.txtfuncao2 = pesquisa7
frmalterar.txtemail2 = pesquisa8
Exit Sub
End Sub

Agradeço desde já pela ajuda!!
Avatar do usuário
Por Reinaldo
Avatar
#11590
Apenas com as rotinas sem poder acompanhar/ver o que rola, vamos utilizar do ACHOMETRO.
ACHO que ao limpar o objeto --> cmbcontato; apos deletar o registro é disparado a rotina change porem não há valor para executar-la; experimente incluir uma validação e veja se funciona:
Algo +/- assim:
Código: Selecionar todos
'Seleciona a Planilha de dados e determina a variável contato
'-----------------------------------------------------------------------------------------------------
shtdados.Select
if frmalterar.cmbcontato<>"" then
         contato = frmalterar.cmbcontato
else
        exit sub
end if
Por Wrush
Posts
#11591
Obrigado Reinaldo, mas onde devo inserir essa validação? No evento change ou na rotina btExcluir?
Avatar do usuário
Por Reinaldo
Avatar
#11607
Evento change
Código: Selecionar todos
Private Sub cmbcontato_Change()

'variaveis para pesquisa
'------------------------------------------------------------------------------------------------------
Dim intervalo As Range
Dim contato As String

'Seleciona a Planilha de dados e determina a variável contato
'-----------------------------------------------------------------------------------------------------
shtdados.Select
if frmalterar.cmbcontato<>"" then
         contato = frmalterar.cmbcontato
else
        exit sub
end if

'Seleciona o intervalo de celulas que armazenam os contatos na planilha
'-----------------------------------------------------------------------------------------------------
Set intervalo = Range("A3:J1048576")

'Pesquisa os campos referente ao contato selecionado na caixa de combinação
'-----------------------------------------------------------------------------------------------------
pesquisa0 = Application.WorksheetFunction.VLookup(contato, intervalo, 2, False) 'endereço
pesquisa1 = Application.WorksheetFunction.VLookup(contato, intervalo, 3, False) 'bairro
pesquisa2 = Application.WorksheetFunction.VLookup(contato, intervalo, 4, False) 'cidade
pesquisa3 = Application.WorksheetFunction.VLookup(contato, intervalo, 5, False) 'telefone residencial
pesquisa4 = Application.WorksheetFunction.VLookup(contato, intervalo, 6, False) 'celular
pesquisa5 = Application.WorksheetFunction.VLookup(contato, intervalo, 7, False) 'codigo
pesquisa6 = Application.WorksheetFunction.VLookup(contato, intervalo, 8, False) 'ramal
pesquisa7 = Application.WorksheetFunction.VLookup(contato, intervalo, 9, False) 'função
pesquisa8 = Application.WorksheetFunction.VLookup(contato, intervalo, 10, False) 'E-mail

frmalterar.txtendereco = pesquisa0
frmalterar.txtbairro2 = pesquisa1
frmalterar.txtcity = pesquisa2
frmalterar.txtresidencial = pesquisa3
frmalterar.txtcelular = pesquisa4
frmalterar.txtcodigo2 = pesquisa5
frmalterar.txtramal2 = pesquisa6
frmalterar.txtfuncao2 = pesquisa7
frmalterar.txtemail2 = pesquisa8
Exit Sub
End Sub
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord