COMPRADOR

Desculpe pela falha. estou anexando o arquivo. Obrigada segue arquivo banco de dados CONTROLE PENDÊNCIAS POR ENDEREÇO-site.zip

Na verdade a tabela dinâmica não atenderia ao que preciso. Mesmo assim obrigada Alguém tem uma luz? rs

boa tarde estou montando um arquivo para consulta no excel, com possibilidade de impressão. O banco de dados fica em arquivo separado. Este seria uma máscara para pessoas de outros setores terem acesso a informação sem contudo alterar ou excluir. Meu arquivo está dando dois bugs: 1) no botão pequisar, abre corretamente o formulário de pequisa e aparecem corretamente todos os endereços contudo quando volto ao userform frmCadastro dando dois cliques em um endereço escolhido ele não atualiza as demais informações para este endereço .Devo ter errado o código. 2)O botão imprimir está dando erro. Ele deveria aparecer com um print do formulário preenchido. Se puderem ajudar agradeço imensamente. Um ótimo final de tarde a todos. segue arquivo: CONSULTA_ENDEREÇOS_site.zip

boa tarde Estou adaptando o cadastro versão 3 do Tomas Vasquez, já tinha adaptado outro para entrada e saída de expedientes e deu tudo certinho com a ajuda de vocês, agora quando fui fazer para outra finalidade, os form pesquisas estão dando erro 13 - tipos incompativeis. Tenho 2 formulários para pesquisa, um de endereços e outro de providências, e ambos estão dando o mesmo erro. Poderiam dar uma olhada? E fiz um outro form com modelo do Renan que tá dando subscrito fora do intervado. É um userform para puxar a ficha do endereço de um terceiro arquivo, mostrar ela em janela e imprimir. Poderiam dar uma olhada tbem? Estou enviando os arquivos em anexo. Muito obrigada controle_endereços = arquivo com userforms bancodedados_engenharia = banco de dados fichas1 = arquivo com máscara para impressão da ficha do endereço. CONTROLE_ENDEREÇOS.zip BANCODEDADOS_ENGENHARIA - Cópia.zip FICHAS1.zip

Obrigada pelas correções Tenho sim os arquivos.. segue eles em anexo. Obrigada mais uma vez!!! ModeloCadastro_v3.zip

Boa tarde Fiz adaptação de planilha do Tomas Vasquez para uso em meu serviço, contudo não sou grande conhecedora de códigos vba. Poderia checar os códigos de meus formulários? São dois arquivos, sendo um de banco de dados e fichas modelo, e outro com os formulários e configurações. Agradeço imensamente. Obrigada CONTROLE_ENDEREÇOS.zip BANCODEDADOS_ENGENHARIA1.zip

Bom dia Fiz um código vba para um botão no excel salvar novos endereços ou alterar existentes (único botão). estou com problema, porque está dando alterar mesmo que o endereço seja novo. Poderiam dar uma olhada no código? Public Sub lsAlteraEnd() Dim lUltimaLinhaAtiva As Long, Resp As Integer Dim wsR As Worksheet, wsC As Worksheet, c As Range Dim j As Long Application.ScreenUpdating = False Set wsR = Worksheets("REGISTRO ENDEREÇOS"): Set wsC = Sheets("CONSULTA ENDEREÇOS") With wsR Set c = .Range("A:A").Find(wsC.[E5], LookAt:=xlWhole) If c Is Nothing Then If .[a2] = "" Then j = 1 Else: j = wsR.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1 If IsNumeric(wsR.Cells(j - 1, 1)) Then wsR.Cells(j, 1) = wsR.Cells(j - 1, 1) + 1 Else wsR.Cells(j, 1) = 1 End If End If [h54] = FormatDateTime((Str(Now)), vbGeneralDate) [e10] = "=IFERROR(INDEX(Tabela1[REGIONAL],MATCH(E5,Tabela1[COD],0)),"""")" [e12] = "=IFERROR(INDEX(Tabela1[TIPO],MATCH(E5,Tabela1[COD],0)),"""")" .Cells(j, 2).Resize(, 1).Value = _ Application.Transpose(wsC.Range("e7").Resize(1).Value) .Cells(j, 3).Resize(, 21).Value = _ Application.Transpose(wsC.Range("e9").Resize(21).Value) .Cells(j, 24).Resize(, 18).Value = _ Application.Transpose(wsC.Range("H10").Resize(21).Value) .Cells(j, 45).Resize(, 20).Value = _ Application.Transpose(wsC.Range("E33").Resize(20).Value) .Cells(j, 65).Resize(, 20).Value = _ Application.Transpose(wsC.Range("H33").Resize(20).Value) .Cells(j, 85).Resize(, 1).Value = _ Application.Transpose(wsC.Range("E54").Resize(1).Value) .Cells(j, 86).Resize(, 1).Value = _ Application.Transpose(wsC.Range("H54").Resize(1).Value) Else Resp = MsgBox("O endereço será alterado, confirma alteração?", vbYesNo, "Confirmação") If Resp = vbYes Then [h54] = FormatDateTime((Str(Now)), vbGeneralDate) [e10] = "=IFERROR(INDEX(Tabela1[REGIONAL],MATCH(E5,Tabela1[COD],0)),"""")" [e12] = "=IFERROR(INDEX(Tabela1[TIPO],MATCH(E5,Tabela1[COD],0)),"""")" .Cells(c.Row, 2).Resize(, 1).Value = _ Application.Transpose(wsC.Range("e7").Resize(1).Value) .Cells(c.Row, 3).Resize(, 21).Value = _ Application.Transpose(wsC.Range("e9").Resize(21).Value) .Cells(c.Row, 24).Resize(, 18).Value = _ Application.Transpose(wsC.Range("H10").Resize(21).Value) .Cells(c.Row, 45).Resize(, 20).Value = _ Application.Transpose(wsC.Range("E33").Resize(20).Value) .Cells(c.Row, 65).Resize(, 20).Value = _ Application.Transpose(wsC.Range("H33").Resize(20).Value) .Cells(c.Row, 85).Resize(, 1).Value = _ Application.Transpose(wsC.Range("E54").Resize(1).Value) .Cells(c.Row, 86).Resize(, 1).Value = _ Application.Transpose(wsC.Range("H54").Resize(1).Value) Else: Exit Sub End If End If lUltimaLinhaAtiva = wsR.Cells(wsR.Rows.Count, 1).End(xlUp).Row wsR.ListObjects("Tabela1").Resize Range("$A$1:$ch$" & lUltimaLinhaAtiva) lcopiaDados Sheets("CONSULTA ENDEREÇOS").Select lslimpaMovimentoConsEnd Application.ScreenUpdating = True End With End Sub Obrigada

como faria isso? porque tem cidades que tem mais de um endereço.

bom dia O problema desta solução é que eu teria toda vez que cadastrasse novo endereço, manualmente inserir ele nesta outra planilha auxiliar. Se a pessoa esquecer já irá gerar problema. Mas obrigada!

Boa tarde preciso criar duas listas de validação dependentes em meu arquivo, quando selecione a cidade, aparece somente os tipos disponiveis de imoveis na cidade, e quando seleciono tbem o tipo, aparece somente os endereços que atendem a estes dois critérios. vou colocar a planilha para facilitar o entendimento. na aba "ficha endereço", quando selecionar o c5, apareceria na listagem de f5 somente os tipos encontrados nesta cidade, e quando seleciono tbem o f5 apareceria em c7 somente os endereços que atenderiam aos critérios escolhidos em c5 e f5. estas 3 celulas teriam listagem de dados, que serão apurados na aba "registro endereços" que será minha base de dados. Esta base contará com 600 endereços aproximadamente. as cidades e tipo aparecem diversas vezes, os endereços não. É possível? Obrigada LISTAS VINCULADAS.xlsx

Deu certíssimo, muito obrigada mais uma vez Osvaldo!!

Bom dia Tenho a seguinte código: Private Sub Worksheet_Change(ByVal Target As range) Dim c As range If Target.Count > 1 Then Exit Sub If Target.Address <> "$D$3" Or Target.Value = "" Then Exit Sub With Sheets("Registro") Set c = .range("A:A").Find([d3]) If Not c Is Nothing Then range("D4").Resize(16).Value = _ Application.Transpose(.Cells(c.Row, 2).Resize(, 16).Value) [D6] = "=IFERROR(INDEX(Tabela9[Área],MATCH(D4,Tabela9[servidor],0)),"""")" [D14] = "=IFERROR(INDEX(TABELA_CIDADES_REGIONAIS[Regional],MATCH(Inclusão!D13,TABELA_CIDADES_REGIONAIS[Cidade],0)),"""")" End If End With End Sub O que acontece é que quando busco o código 288 (0288) na D3, ele me retorna os dados do registro 4288. Ou seja não está fazendo a busca exata. Como faço para alterar o código acima para esta busca exata do número? Obrigada

É possível armazenar na vertical ao invés de horizontal as fotos?

Bom dia estou tentando inserir figura vinculada a endereço na minha planilha de consulta e não estou conseguindo. tentei fórmulas da net mas não funcionou. Não quero usar userform porque o arquivo será utilizado por vários usuários e quero fazer o mais simples possível. Tenho uma lista de validação com diversos endereços e queria que quando selecionasse um automaticamente a figura carregasse para a foto da fachada deste imóvel. É possível? de maneira simples? As fotos podem ser arquivadas no micro de rede utilizado como servidor ou podem ser arquivadas em coluna na plan usada para registro do banco de dados dos endereços existentes. Alguma luz? Muito obrigada Alessandra

Ops, desculpe..rs coloquei no vba, esta pasta de trabalho o código abaixo: Private Sub Workbook_Open() Windows("Controle Expedientes_ENTRA E SAÍDA_ENGENHARIA.xlsm").Activate Sheets("Menu").Activate ActiveWindow.DisplayWorkbookTabs = False End Sub Deu certinho., pelo menos por hora..rs Valeu!!

Boa noite Estou com este erro aparecendo no código abaixo. Já procurei bastante na net, tentei de tudo, mas continua dando. Sei que é erro de compatibilidade, alguém tem uma luz? A linha que fica destacada pelo erro é a em vermelho. Obrigada Código: Private Sub Worksheet_Change(ByVal Target As range) Dim c As range Sheets("Inclusão").Unprotect "controleaa" If Target.Count > 1 Then Exit Sub If Target.Address <> "$D$3" Or Target.Value = "" Then Exit Sub With Sheets("Registro") Set c = .range("A:A").Find([D3]) If Not c Is Nothing Then range("D4").Resize(16).Value = _ Application.Transpose(.Cells(c.Row, 2).Resize(, 16).Value) [D6] = "=IFERROR(INDEX(Tabela9[Área],MATCH(D4,Tabela9[servidor],0)),"""")" [D14] = "=IFERROR(INDEX(TABELA_CIDADES_REGIONAIS[Regional],MATCH(Inclusão!D13,TABELA_CIDADES_REGIONAIS[Cidade],0)),"""")" End If End With Sheets("Inclusão").Protect "controleaa" End Sub

consegui resolver este problema.. Muito obrigada

Mas quando faço isto e vou usar os hiperlinks da Plan 1(Menu) eles deixam de funcionar.

Ficou perfeito, arrasou!! agora tem algum código para que quando apareça o arquivo só apareça a plan 1? sem ser via vba?

Testei, como faço para excluir a colagem das células D6 e D13? porque elas tem fórmulas, se buscar a informação está apagando a fórmula. Obrigada

Osvaldo Fiz o teste, mas quando digito ele não mostra as informações previamente cadastradas para alteração. Tem como fazer aparecer? Aí altero o que preciso e atualizo o registro. Pode ser na mesma linha já existente. Não sei se seria necessário um novo botão atualizar separado. Um de cadastro onde vendo que o código já existe e carregando as informações salvas e outro para atualizar depois de alterar.

Osvaldo Bom dia Ele está encontrando o código igual, mas pergunta se quer alterar, quando ponho sim, apaga tudo e teria que digitar todo os dados do expediente novamente. Na verdade preciso que ele carregue os dados do código já encontrado para que eu altere ou inclua algo, delete a linha do código anterior e salve este com as alterações. É possivel? Obrigada

Bom dia Estou fazendo uma planilha para cadastro de documentos (entrada e saída) e quero algo simples, só com macros, porque será acessado em diversos computadores, nem todos tão atuais. Estou com um problema no código do botão de inserção de documentos (quero que ele verifique se o código já existe, se existir perguntar se quer alterar e fazer desta forma, se não, cadastrar novo documento). O código abaixo não consegue achar o valor do range D3 quando já existe. Algo está errado.. segue o arquivo : http://www.sendspace.com/file/1kq2i0 segue o código: Public Sub lsIncluirExpediente() Dim lUltimaLinhaAtiva As Long Dim Resp As Integer lUltimaLinhaAtiva = Worksheets("Registro").Cells(Worksheets("Registro").Rows.Count, 1).End(xlUp).Row + 1 Worksheets("Inclusão").Range("D3").Select With Worksheets("Registro").Range("A:A") Set c = .Find(ActiveCell.Value, LookIn:=xlValues, LookAt:=xlPart) If Not c Is Nothing Then Resp = MsgBox("Código ENG não encontrado, deseja cadastrar?", vbYesNo, "Confirmação") If Resp = vbYes Then 'ENG Worksheets("Registro").Cells(lUltimaLinhaAtiva, 1).Value = Worksheets("Inclusão").Range("d3").Value 'Servidor Worksheets("Registro").Cells(lUltimaLinhaAtiva, 2).Value = Worksheets("Inclusão").Range("d4").Value 'Razao Worksheets("Registro").Cells(lUltimaLinhaAtiva, 3).Value = Worksheets("Inclusão").Range("d5").Value 'Area Worksheets("Registro").Cells(lUltimaLinhaAtiva, 4).Value = Worksheets("Inclusão").Range("d6").Value 'Em conjunto Worksheets("Registro").Cells(lUltimaLinhaAtiva, 5).Value = Worksheets("Inclusão").Range("d7").Value 'Data Entrada Worksheets("Registro").Cells(lUltimaLinhaAtiva, 6).Value = Worksheets("Inclusão").Range("d8").Value 'Protocolo Worksheets("Registro").Cells(lUltimaLinhaAtiva, 8).Value = Worksheets("Inclusão").Range("d10").Value 'Tipo Worksheets("Registro").Cells(lUltimaLinhaAtiva, 9).Value = Worksheets("Inclusão").Range("d11").Value 'Cidade Worksheets("Registro").Cells(lUltimaLinhaAtiva, 10).Value = Worksheets("Inclusão").Range("d12").Value 'Regional Worksheets("Registro").Cells(lUltimaLinhaAtiva, 11).Value = Worksheets("Inclusão").Range("d13").Value 'Solicitante Worksheets("Registro").Cells(lUltimaLinhaAtiva, 12).Value = Worksheets("Inclusão").Range("d14").Value 'Descrição Worksheets("Registro").Cells(lUltimaLinhaAtiva, 13).Value = Worksheets("Inclusão").Range("d15").Value 'Gravidade Worksheets("Registro").Cells(lUltimaLinhaAtiva, 14).Value = Worksheets("Inclusão").Range("d16").Value 'Urgencia Worksheets("Registro").Cells(lUltimaLinhaAtiva, 15).Value = Worksheets("Inclusão").Range("d17").Value End If Else Resp = MsgBox("Operação cancelada") End If 'Carregando o botão de opção If c.Value = True Then Resp = MsgBox("Código ENG já existe, deseja alterar?", vbYesNo, "Confirmação") If Resp = vbYes Then c.Select Selection.EntireRow.Delete Worksheets("Registro").Select lUltimaLinhaAtiva = Worksheets("Registro").Cells(Worksheets("Registro").Rows.Count, 1).End(xlUp).Row + 1 c.Activate 'ENG Worksheets("Registro").Cells(lUltimaLinhaAtiva, 1).Value = Worksheets("Inclusão").Range("d3").Value 'Servidor Worksheets("Registro").Cells(lUltimaLinhaAtiva, 2).Value = Worksheets("Inclusão").Range("d4").Value 'Razao Worksheets("Registro").Cells(lUltimaLinhaAtiva, 3).Value = Worksheets("Inclusão").Range("d5").Value 'Area Worksheets("Registro").Cells(lUltimaLinhaAtiva, 4).Value = Worksheets("Inclusão").Range("d6").Value 'Em conjunto Worksheets("Registro").Cells(lUltimaLinhaAtiva, 5).Value = Worksheets("Inclusão").Range("d7").Value 'Data Entrada Worksheets("Registro").Cells(lUltimaLinhaAtiva, 6).Value = Worksheets("Inclusão").Range("d8").Value 'Protocolo Worksheets("Registro").Cells(lUltimaLinhaAtiva, 8).Value = Worksheets("Inclusão").Range("d10").Value 'Tipo Worksheets("Registro").Cells(lUltimaLinhaAtiva, 9).Value = Worksheets("Inclusão").Range("d11").Value 'Cidade Worksheets("Registro").Cells(lUltimaLinhaAtiva, 10).Value = Worksheets("Inclusão").Range("d12").Value 'Regional Worksheets("Registro").Cells(lUltimaLinhaAtiva, 11).Value = Worksheets("Inclusão").Range("d13").Value 'Solicitante Worksheets("Registro").Cells(lUltimaLinhaAtiva, 12).Value = Worksheets("Inclusão").Range("d14").Value 'Descrição Worksheets("Registro").Cells(lUltimaLinhaAtiva, 13).Value = Worksheets("Inclusão").Range("d15").Value 'Gravidade Worksheets("Registro").Cells(lUltimaLinhaAtiva, 14).Value = Worksheets("Inclusão").Range("d16").Value 'Urgencia Worksheets("Registro").Cells(lUltimaLinhaAtiva, 15).Value = Worksheets("Inclusão").Range("d17").Value Else Resp = MsgBox("Operação cancelada") End If 'Limpa o movimento lsLimpaMovimento End If End With End Sub Se puderem ajudar, agradeço!!!