Excel Planilha Controle de contas a pagar

Michel E Amanda · 19 de março de 2019

Bom dia, estou criando um controle de contas a pagar, com uma opção de lançar vários lançamentos de uma vez só.
O problema é que tenho que fazer cada lançamento ser inserido com a data do mês seguinte.
Até chegar no mês 12 está dando certo, mas depois da errado e começa a altera o dia ao invés do mês.
Gostaria por favor, de ajuda para ver o que está sendo feito errado.
Segue abaixo parte do código que usei. Vou inserir também o arquivo (eu salvei o arquivo em pasta de trabalho comum, para anexar aqui, tem que salvar como planilha habilitada para macros para testar. Criei um botão para usar a macro e coloquei a opção ctrl l também.

Private Sub CommandButton2_Click()

ThisWorkbook.Worksheets("CONTAS").Activate
'Selecionar a célula A3
Range("A2").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

'Carregar os dados digitados nas caixas de texto para a planilha
ActiveCell.Offset(0, 2).Value = TextData.Value
ActiveCell.Offset(0, 0).Value = ComboEmpresa.Value
ActiveCell.Offset(0, 3).Value = TextBox2.Value

Dim i As Integer

For i = 1 To TextBox3.Value

If i = 1 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 1)
ElseIf i = 2 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 2)
ElseIf i = 3 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 3)
ElseIf i = 4 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 4)
ElseIf i = 5 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 5)
ElseIf i = 6 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 6)
ElseIf i = 7 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 7)
ElseIf i = 8 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) +
ElseIf i = 9 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 9)
ElseIf i = 10 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 10)
ElseIf i = 11 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 11)
ElseIf i = 12 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 12)
ElseIf i = 13 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 13)
ElseIf i = 14 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 14)
ElseIf i = 15 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 15)
ElseIf i = 16 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 16)
ElseIf i = 17 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 17)
ElseIf i = 18 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 18)
ElseIf i = 19 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 19)
ElseIf i = 20 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 20)
ElseIf i = 21 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 21)
ElseIf i = 22 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 22)
ElseIf i = 23 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 23)
ElseIf i = 24 Then
TextData1.Text = DateSerial(Year(TextData.Value), Month(TextData.Value), Day(TextData.Value) + 24)
End If

'Ativar a primeira planilha
ThisWorkbook.Worksheets("CONTAS").Activate
'Selecionar a célula A3
Range("A2").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

'Carregar os dados digitados nas caixas de texto para a planilha
ActiveCell.Offset(0, 2).Value = TextData1.Value
ActiveCell.Offset(0, 0).Value = ComboEmpresa.Value
ActiveCell.Offset(0, 3).Value = TextBox2.Value

Next i
Unload Me
End Sub

CONTAS A PAGAR CHICO ROSAteste.xlsx

20 de março de 2019

Sugestão: disponibilize uma amostra do seu arquivo Excel com os controles (Text/Combo) e com os códigos.

Compacte o arquivo.

Michel E Amanda · 20 de março de 2019

Obrigado pela sugestão.
Segue em anexo.

CONTAS A PAGAR CHICO ROSAteste.rar

21 de março de 2019

Experimente o código abaixo no lugar do atual.

Private Sub CommandButton2_Click()
 Dim LR As Long, i As Long
  Application.Calculation = xlCalculationManual
  LR = Cells(Rows.Count, 1).End(3).Row
  i = TextBox3.Value
  Cells(LR + 1, 1).Resize(i + 1) = ComboEmpresa.Value
  Cells(LR + 1, 4).Resize(i + 1).Value = TextBox2.Value
  Cells(LR + 1, 3) = Format(TextData.Value, "mm/dd/yyyy")
  Cells(LR + 2, 3) = "=EDATE(C$" & LR + 1 & ",Row(A1))"
  Cells(LR + 2, 3).Resize(i).FillDown
  Application.Calculation = xlCalculationAutomatic
  Cells(LR + 2, 3).Resize(i + 1).Value = Cells(LR + 2, 3).Resize(i + 1).Value
  Unload Me
End Sub

Michel E Amanda · 21 de março de 2019

8 horas atrás, osvaldomp disse:

Experimente o código abaixo no lugar do atual.


Private Sub CommandButton2_Click()
 Dim LR As Long, i As Long
  Application.Calculation = xlCalculationManual
  LR = Cells(Rows.Count, 1).End(3).Row
  i = TextBox3.Value
  Cells(LR + 1, 1).Resize(i + 1) = ComboEmpresa.Value
  Cells(LR + 1, 4).Resize(i + 1).Value = TextBox2.Value
  Cells(LR + 1, 3) = Format(TextData.Value, "mm/dd/yyyy")
  Cells(LR + 2, 3) = "=EDATE(C$" & LR + 1 & ",Row(A1))"
  Cells(LR + 2, 3).Resize(i).FillDown
  Application.Calculation = xlCalculationAutomatic
  Cells(LR + 2, 3).Resize(i + 1).Value = Cells(LR + 2, 3).Resize(i + 1).Value
  Unload Me
End Sub

Osvaldomp deu certinho. O mês e a data estavam ficando invertido. Alterei esta parte do código: Cells(LR + 1, 3) = Format(TextData.Value, "mm/dd/yyyy"), para Cells(LR + 1, 3) = Format(TextData.Value, "dd/mm/yyyy") e funcionou perfeitamente.

E a parte do código que direciona o local onde os dados serão inseridos ficou muito mais rápido do que este outro código que eu estava utilizando.
Muito obrigado, que Deus te abençoe e retribua em dobro.

21 de março de 2019

2 horas atrás, Michel E Amanda disse:

O mês e a data estavam ficando invertido.

Manipular datas em VBA é sempre um pé, pois o VBA já nasceu viciado no formato dos EUA. Na minha versão, para retornar a data no formato dd/mm/aaaa, é preciso formatar como mm/dd/yyyy, já na sua funciona como dd/mm/yyyy.

E a parte do código que direciona o local onde os dados serão inseridos ficou muito mais rápido do que este outro código que eu estava utilizando.
Em parte a melhoria na rapidez foi conseguida mudando o cálculo para manual, pois a cada inserção de dado na planilha a planilha recalculava, provocando a lentidão. E outra parte é que o código que passei não utiliza o desnecessário e indesejável comando Select.

A propósito, o recálculo da sua planilha está lento devido ao excesso de fórmulas.

Michel E Amanda · 21 de março de 2019

@osvaldomp Ficou ótimo.
Como eu utilizo este calculo manual para inserir apenas um lançamento em uma linha apenas.
Este botão que você criou o código para mim é utilizado quando tem que lançar a mesma conta várias vezes.
Mas tenho o caso de contas que são lançadas uma vez só. Eu utilizo o mesmo código no outro botão e ele também fica muito lento para inserir.

21 de março de 2019

Experimente o código abaixo no lugar.

Private Sub CommandButton1_Click()
 Application.Calculation = xlCalculationManual
  Cells(Rows.Count, 3).End(3)(2) = Format(TextData.Value, "dd/mm/yyyy")
  Cells(Rows.Count, 1).End(3)(2) = ComboEmpresa.Value
  Cells(Rows.Count, 4).End(3)(2) = TextBox2.Value
  Application.Calculation = xlCalculationAutomatic
 Unload Me
End Sub

obs.

1. coloquei o TextData no mesmo formato que você informou que funcionou corretamente no código anterior

2. você provavelmente notou que o código anterior não utiliza a TextData1, então se você quiser poderá removê-la do Form

Michel E Amanda · 21 de março de 2019

Perfeito!!
Vou tentar utilizar em outros projetos também.
Sobre o excesso de fórmulas. Existe alguma forma de inserir a formula pelo vba, já com as referências corretas? Acompanhando o número da linha onde foi inserida.

22 de março de 2019

12 horas atrás, Michel E Amanda disse:

Existe alguma forma de inserir a formula pelo vba, já com as referências corretas? Acompanhando o número da linha onde foi inserida.

Experimente gravar uma macro e incorporá-la aos seus códigos ou chamá-la a partir deles.

Se precisar de algum ajuste coloque aqui o código gravado.

Michel E Amanda · 22 de março de 2019

@osvaldomp Tá bom.
Muito obrigado por toda a ajuda

Michel E Amanda · 24 de março de 2019

Em 21/03/2019 às 17:31, osvaldomp disse:
Experimente o código abaixo no lugar.
Private Sub CommandButton1_Click()
 Application.Calculation = xlCalculationManual
  Cells(Rows.Count, 3).End(3)(2) = Format(TextData.Value, "dd/mm/yyyy")
  Cells(Rows.Count, 1).End(3)(2) = ComboEmpresa.Value
  Cells(Rows.Count, 4).End(3)(2) = TextBox2.Value
  Application.Calculation = xlCalculationAutomatic
 Unload Me
End Sub
obs.

1. coloquei o TextData no mesmo formato que você informou que funcionou corretamente no código anterior

2. você provavelmente notou que o código anterior não utiliza a TextData1, então se você quiser poderá removê-la do Form

Boa tarde osvaldomp!
Eu utilizei este código que você me passou em outro projeito, onde uma das textbox vai ser preenchida de acordo com um critério. Quando não ocorrer a situação do critério ele ficará em branco e por consequência a célula na coluna onde a textbox está inserindo também fica em branco.
No próximo lançamento que faço, onde esta textbox recebe valor, ela insere na primeira linha em branco, de cima para baixo, deixando assim o valor em uma linha diferente do restante dos dados do lançamento.
Você poderia por gentileza, me falar como faço para inverter isto, colocando para o código achar a ultima linha em branco, de baixo para cima? Ou considerar a primeira linha em branco, de cima para baixo só da coluna "A"?

25 de março de 2019

23 horas atrás, Michel E Amanda disse:

Ou considerar a primeira linha em branco, de cima para baixo só da coluna "A"?

Para tomar como base a primeira vazia em A de baixo para cima, altere as três linhas conforme abaixo.

 Cells(Rows.Count, 1).End(3)(2, 3) = Format(TextData.Value, "dd/mm/yyyy")
 Cells(Rows.Count, 1).End(3)(2) = ComboEmpresa.Value
 Cells(Rows.Count, 1).End(3)(1, 4) = TextBox2.Value