Ir ao conteúdo
  • Cadastre-se
COMPRADOR

Dúvidas em código macro excel

Recommended Posts

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!!!

Compartilhar este post


Link para o post
Compartilhar em outros sites

Fiz pequenas alterações. Testaí:

Public Sub lsIncluirExpediente()    Dim lUltimaLinhaAtiva As Long, Resp As Integer    Dim wsR As Worksheet, wsI As Worksheet, c As Range        Set wsR = Worksheets("Registro"): Set wsI = Sheets("Inclusão")    With wsR      If .[A2] = "" Then        lUltimaLinhaAtiva = 1      Else: lUltimaLinhaAtiva = .Cells(1, 1).End(xlDown).Row      End If      Set c = .Range("A:A").Find(wsI.[D3])        If c Is Nothing Then          .Cells(lUltimaLinhaAtiva + 1, 1).Resize(, 15).Value = _            Application.Transpose(wsI.Range("D3").Resize(15).Value)        Else          Resp = MsgBox("Código ENG já existe, deseja alterar?", vbYesNo, "Confirmação")            If Resp = vbYes Then             .Cells(c.Row, 2).Resize(, 14).Value = _                Application.Transpose(wsI.Range("D4").Resize(14).Value)            Else: Exit Sub            End If        End If    End With'Limpa o movimentolsLimpaMovimento    End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

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.

 

 

Se o registro já existe o código acima salva as novas informações na mesma linha do código, em lugar de excluí-lo e recadastrá-lo.

Faça testes colocando um código já existente e alterando alguns campos e veja o resultado.

 

No entanto se você preferir excluir o já existente e colocá-lo como novo registro, podemos alterar no código que passei.

Compartilhar este post


Link para o post
Compartilhar em outros sites

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.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Veja se este caminho é bom:

Instale o código abaixo no módulo da planilha "Inclusão", assim:
1. copie o código daqui
2. clique com o direito na guia da planilha "Inclusão" e escolha 'Exibir código'
3. cole o código na janela em branco que vai se abrir
4. feito! 'Alt+Q' para retornar para a planilha e testar
 

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(14).Value = _                Application.Transpose(.Cells(c.Row, 2).Resize(, 14).Value)        End If    End WithEnd Sub

Funcionamento - coloque em "D3" da planilha "Inclusão" o nome que deseja cadastrar ou alterar.
Se o nome colocado em "D3" já existe na planilha "Registro" o código irá carregar as informações relativas àquele nome na planilha "Inclusão", conforme a sua ideia. O carregamento será automático, não é necessário novo botão para rodar o código acima.

Quanto ao outro código que passei nada muda, e pode continuar utilizando o botão "INCLUIR" para acioná-lo.

Retorne se precisar mais ajustes.

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

Coloque este no lugar do último que postei (o do post #6)

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(14).Value = _                Application.Transpose(.Cells(c.Row, 2).Resize(, 14).Value)          [D6] = "=IFERROR(INDEX(Tabela6[Área],MATCH(D4,Tabela6[Servidor],0)),"""")"          [D13] = "=IFERROR(INDEX(TABELA_CIDADES_REGIONAIS[Regional],MATCH(Inclusão!D12,TABELA_CIDADES_REGIONAIS[Cidade],0)),"""")"        End If    End WithEnd Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

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?

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

 

O que você chama de "código sem ser VBA" ?

 

Um caminho é deixar a Plan1 visível e ocultar as demais antes de salvar.

Compartilhar este post


Link para o post
Compartilhar em outros sites

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!!

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×