Manter informação n...
 
Notifications
Clear all

Manter informação na mesma linha

15 Posts
3 Usuários
0 Reactions
3,029 Visualizações
(@robertonl)
Posts: 0
New Member
Topic starter
 

Boa noite.
Ao alterar os dados de um registro, os dados não ficam na mesma linha, eles são inseridos na próxima linha em branco.
Como proceder neste caso para que o registro mantenha na mesma linha para que o arquivo não fique sobrecarregado

Private Sub Cmd_Salvar_Click()
If Me.Cmd_Alterar = True Then
 ThisWorkbook.Worksheets("Fornecedor") = Txt_RazaoSocial
 ThisWorkbook.Worksheets("Fornecedor") = Txt_Fantasia
Else
intlinha = ThisWorkbook.Worksheets("Fornecedor").Range("A500").End(xlUp).Offset(1, 0).Row
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 1) = CStr(Cod_Fornecedor)
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 2) = Txt_RazaoSocial
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 3) = Txt_Fantasia
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 4) = Txt_CNPJCPF
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 5) = Txt_Cidade
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 6) = Txt_UF
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 7) = Txt_Tel1
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 8) = Txt_Tel2
ThisWorkbook.Worksheets("Fornecedor").Cells(intlinha, 9) = Txt_Email
End If
Me.Cmd_Novo.Enabled = True
Me.Cod_Fornecedor = ""
Me.Txt_RazaoSocial = ""
Me.Txt_Fantasia = ""
Me.Txt_CNPJCPF = ""
Me.Txt_Cidade = ""
Me.Txt_UF = ""
Me.Txt_Tel1 = ""
Me.Txt_Tel2 = ""
Me.Txt_Email = ""
  With Sheets("Fornecedor")
           
            'Obtém a última linha da Planilha:
            rLast = .Cells(.Rows.Count, "A").End(xlUp).Row + 0
       
            If rLast <= 9 Then
                Cod_Fornecedor.Caption = "FO" & "00000" & rLast     '& "00000"
            Else
                Cod_Fornecedor.Caption = "FO" & "0000" & rLast     '& "00000"
            End If
        End With
        
End Sub

 
Postado : 02/09/2018 6:03 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

robertonl,

Bom dia!

Altere essa linha:

intlinha = ThisWorkbook.Worksheets("Fornecedor").Range("A500").End(xlUp).Offset(1, 0).Row

Para:

intlinha = ThisWorkbook.Worksheets("Fornecedor").Range("A500").End(xlUp).Offset(0, 0).Row
 
Postado : 03/09/2018 7:22 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Apesar de que a proposta/solução do colega Wagner atenda ao descrito na demanda

Manter informação na mesma linha

Acredito; apenas um acho; que não seja o desejado/esperado pelo usuário, pois a rotina disponibilizada não está "preparada" para alterações,
somente inclusão de novo registro; sendo esse o motivo de acréscimo em nova linha.

Contudo,por ser um achometro, se a solução proposta é o realmente esperado, OK,
caso contrario forneça maiores detalhes e um modelo/exemplo de sua necessidade

 
Postado : 03/09/2018 8:04 am
(@robertonl)
Posts: 0
New Member
Topic starter
 

Boa noite.
Utilizei a orientação, porem não deu certo.
Porém utilizei o código, mas quando eu necessito alterar alguma informação, ele altera e ao salvar o dado é gravado na ultima linha em que tem alguma informação.
A ideia principal é salvar a alteração na linha que a informação se encontra

Private Sub Editar_Click()
'Me.CentroCusto.Enabled = True
'Me.ContaCorrente.Enabled = True
'Me.PerCCalc.Enabled = True
'Me.Salvar.Enabled = True
'Me.CentroCusto.SetFocus
'If Me.Editar = True Then
  Dim intlinha
  intlinha = ThisWorkbook.Worksheets("Centro_Custo").Range("A500").End(xlUp).Offset(0, 0).Row
  ThisWorkbook.Worksheets("Centro_Custo").Cells(intlinha, 1) = CStr(CentroCusto)
  ThisWorkbook.Worksheets("Centro_Custo").Cells(intlinha, 2) = CStr(ContaCorrente)
  ThisWorkbook.Worksheets("Centro_Custo").Cells(intlinha, 3) = CDbl(PerCCalc)
Me.CentroCusto = ""
Me.ContaCorrente = ""
Me.PerCCalc = ""

End Sub
 
Postado : 07/09/2018 4:59 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

robertonl,

Boa tarde!

Anexe seu arquivo ou um exemplo pequeno (no máximo 5 linhas) compactado com .ZIP e explique melhor a sua necessidade.

 
Postado : 10/09/2018 9:28 am
(@robertonl)
Posts: 0
New Member
Topic starter
 

Qualquer alteração que realizo a informação é salva no ultimo registro. Desejo que a alteração seja feita e mantenha na mesma linha

 
Postado : 15/09/2018 9:30 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Efetuei diversar alterações espero que atenda

 
Postado : 16/09/2018 6:38 am
(@robertonl)
Posts: 0
New Member
Topic starter
 

Funcionou perfeitamente.

 
Postado : 16/09/2018 3:48 pm
(@robertonl)
Posts: 0
New Member
Topic starter
 

Boa noite.
Realizei alteração de como buscar realizar alteração nos registros.
Tentei adaptar em cima daquele que você me enviou, porém está dando erro.
Onde provavelmente posso ter errado na estrutura da macro.

 
Postado : 16/09/2018 5:35 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente

 
Postado : 17/09/2018 6:32 am
(@robertonl)
Posts: 0
New Member
Topic starter
 

Habilitando a tecla alterar, quando salvar as informações alteradas, está dando tipo imcompativel e a linha fica selecionanda em amarelo
Erro tempo execução 13
Tipo incompatíveis.
IntLinha = Me.Lbl_Linha.Caption

 
Postado : 17/09/2018 10:50 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Voce alterou seu projeto sem atentar as alterações que foram feita.Veja que é "carregado" no list o numero da linha do registro, isso facilita na hora de alterar/excluir o registro, tambem foi incluido um label para "conter" o numero da linha do registro em alteração, possibilitando assim a modificação sem necessidade de nova pesquisa de posição. Verifique e tente adequar, se não conseguir informe que amanhã tento ajustar.

 
Postado : 17/09/2018 2:27 pm
(@robertonl)
Posts: 0
New Member
Topic starter
 

não consegui, tentei algumas alterações, mas continua dando erro que mencionei anteriormente.

 
Postado : 18/09/2018 9:59 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente

 
Postado : 18/09/2018 11:10 am
(@robertonl)
Posts: 0
New Member
Topic starter
 

Funcionou perfeitamente, como planejado.

 
Postado : 18/09/2018 11:30 am