Este fórum está sendo desativado

[SandroLima]

Boa tarde, pessoal

Como faço para repetir uma data de vencimento mensalmente?

Suponhamos que uma determinada célula de uma tabela me traga uma data de vencimento e eu queira manter o dia de vencimento no mês seguinte. Como deveria escrever essa linha desse código?
A grosso modo seria algo assim:

Código: Selecionar todos

Tabela.ListRows(1).Range(, 21).Value = Tabela.ListRows(2).Range(, 21).Value + 30

Mas entendam que a data de vencimento seria o mesmo dia de cada mês e não a cada 30 dias. Por exemplo todo dia 10 de cada mês. (10/11/20018, 10/12/2018, 10/01/2019 etc).

Obrigado a quem puder colaborar

[gfranco]

Boa noite.
Veja se é isso que precisa:
Cole o código a seguir num módulo, abra a janela de verificação imediata (CTRL + G) e rode o código.

Código: Selecionar todos

Sub main()

        Dim i As Byte

    For i = 1 To 10
    
        Debug.Print VBA.DateSerial(2018, 9 + i - 1, 1)
    
    Next i

End Sub

[SandroLima]

Boa noite, pessoal.

Obrigado pela intenção de ajudar, GFranco.

Como não consegui aplicar o seu código à minha necessidade resolvi anexar um modelo resumido da planilha e os dois códigos que utilizo.

O primeiro botão (verde) serve para anexar um novo registro.

A ideia do segundo botão (laranja) seria realizar o parcelamento a partir da quantidade de parcelas informadas no último registro da tabela (no caso dessa tabela seria o registro da primeira linha) anexando então uma linha para cada parcela e informando as datas de vencimento (sempre com dia fixo do mês de vencimento - de acordo com a data informada no registro da primeira linha da tabela) e a competência daquela parcela em relação aos vencimentos (parcela 1 de x, parcela 2 de x, etc)

Acho que na planilha consegui deixar melhor explicado.

As linhas dos registros 7, 8 e 9 da tabela simulam o resultado desejado.

Obrigado a quem puder ajudar.

[babdallas]

Não tive tempo de olhar seu arquivo, mas uma outra maneira é usar a função DATAM no VBA.
Pequeno exemplo

Código: Selecionar todos

Public Sub Teste()

     Dim lngNParcelas as Long
     Dim lngContador as Long
     Dim datData as Date

     datData = VBA.DateSerial(2018,11,30) 'Data de 30/11/2018

     lngNParcelas = 30 'Número de parcelas
     
     'Mostra a partir da célula A1 as datas equivalentes nos próximos meses
     for lngContador = 1 to lngNParcelas
             wshTeste.cells(lngContador,1) = Application.WorksheetFunction.Datam(datData, lngContador)
     next lngContador

End Sub

[babdallas]

Corrigindo a função datam em inglês...

Código: Selecionar todos

Public Sub Teste()

     Dim lngNParcelas As Long
     Dim lngContador As Long
     Dim datData As Date

     datData = VBA.DateSerial(2018, 11, 30) 'Data de 30/11/2018

     lngNParcelas = 30 'Número de parcelas
     
     'Mostra a partir da célula A1 as datas equivalentes nos próximos meses
     For lngContador = 1 To lngNParcelas
             wshTeste.Cells(lngContador, 1) = Application.WorksheetFunction.EDate(datData, lngContador)
     Next lngContador

End Sub

[SandroLima]

Bom dia, pessoal.

Obrigado pela ajuda, Babdallas.

Infelizmente também não soube aplicar o seu código na minha planilha.

Fico no aguardo se você ou alguém mais puder ajudar.

Muito obrigado de novo e tenha um bom dia.

[Reinaldo]

uma possibilidade, experimente.
Altere/troque a rotina -->"InserirNovaParcela"<-- pela abaixo

Código: Selecionar todos

Sub InserirNovaParcela()
Dim TabelaAtividades As ListObject

Set TabelaAtividades = wshAtividadesDiarias.ListObjects("TB_AtividadesDiarias")

Application.ScreenUpdating = False
    
For x = 2 To TabelaAtividades.ListRows(1).Range(1, 11).Value
    
TabelaAtividades.ListRows.Add (1), alwaysinsert:=True
TabelaAtividades.ListRows(2).Range.Copy
TabelaAtividades.ListRows(1).Range.PasteSpecial xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
    
TabelaAtividades.ListRows(1).Range(, 3).FormulaLocal = "=PRI.MAIÚSCULA(TEXTO([@Data];""DDDD""))"
TabelaAtividades.ListRows(1).Range(, 1).Value = TabelaAtividades.ListRows(1).Range(, 1).Value + 1
TabelaAtividades.ListRows(1).Range(, 12).Value = _
                TabelaAtividades.ListRows(1).Range(, 10).Value / TabelaAtividades.ListRows(1).Range(, 11).Value
TabelaAtividades.ListRows(1).Range(, 13).Value = "Parcela " & x & " de " & _
                TabelaAtividades.ListRows(1).Range(, 11).Value
TabelaAtividades.ListRows(1).Range(, 15).Value = _
                VBA.DateAdd("m", 1, TabelaAtividades.ListRows(1).Range(, 15))
Next

Set TabelaAtividades = Nothing
Application.ScreenUpdating = True
End Sub

[SandroLima]

Obrigado, Reinaldo.

Com algumas pequenas adequações aqui para a planilha atendeu perfeitamente.

Muito obrigado mesmo.