[Resolvido]Parcelamentos dias úteis

Bom dia! Fiz desta forma mais repete no sábado e domingos repete o dia de segunda.

Ex:Vencimento

03/08/2020 Segunda
04/08/2020 Terça
05/08/2020 Quarta
06/08/2020 Quita
07/08/2020 Sexta
10/08/2020 Sábado
10/08/2020 Domingo
10/08/2020
11/08/2020
12/08/2020

Desde já fico agradecido!

Obs: Parcelas diárias

Dim db
Dim rs
Dim i As Integer

Set db = CurrentDb()
Set rs = db.OpenRecordset("tbl_LancChequeDet") 'Abre Tbl_ContasAreceber
ValorCheque = Me.txtTotalRecebe / Me.QtdeParcelas 'Valor de cada Parcela

For i = 1 To Me.QtdeParcelas 'Insere as Parcela na Tbl_ContasAreceber
rs.AddNew
rs("Cod_Lançamento") = Me.Cod_Lance
rs("NumCheque") = Right("00" & i, 2) & "/" & Right("00" & Me.QtdeParcelas, 2)
rs("ValorCheque") = Me.txtTotalRecebe / Me.QtdeParcelas
rs("VencCheque") = DateAdd("d", i - 1, Me.txtDt_1Parcela) 'Calcula as datas de Vencto através da função DateAdd()
rs("DataLanc") = Me.txtDataLanc
rs("Taxa") = Me.txtTaxa
If Weekday(rs("VencCheque")) = 1 Or Weekday(rs("VencCheque")) = 7 Then
Do
IncrementaData:
rs("VencCheque") = DateAdd("d", 1, rs("VencCheque"))
If Weekday(rs("VencCheque")) = 1 Or Weekday(rs("VencCheque")) = 7 Then
GoTo IncrementaData
Else
Exit Do
End If
Loop
End If
rs.Update
Next
rs.Close
db.Close
Me.frm_LancChequeDetSub.Requery 'Atualiza o SubForm
Me.btn_Diário.enabled = False

Up

Obrigado!

Deixo aqui código como ficou resolvido, para quem tiver o mesmo problema.


Dim sDT As String
Dim DT As Date
Dim freqNum As Long
Dim freq As String
Dim db As DAO.Database, rs As DAO.Recordset
Dim ValorCheque As Currency, i, Fim_semana As Byte

Set db = CurrentDb()
Set rs = db.OpenRecordset("tbl_LancChequeDet") 'Abre Tbl_ContasAreceber
         
       ValorCheque = Me.txtTotalRecebe / Me.QtdeParcelas 'Valor de cada Parcela
   
   For i = 1 To Me.QtdeParcelas  'Insere as Parcela na Tbl_ContasAreceber
       rs.AddNew
       rs("Cod_Lançamento") = Me.Cod_Lance
       rs("NumCheque") = Right("00" & i, 2) & "/" & Right("00" & Me.QtdeParcelas, 2)
       rs("ValorCheque") = Me.txtTotalRecebe / Me.QtdeParcelas
       'Calcula as datas de Vencto através da função DateAdd()
   sDT = DateAdd("d", ((i - 1) + Fim_semana), Me.txtDt_1Parcela)
   DT = CDate(sDT) '' Converto a data (string) em data (date)
   '' Abaixo, testo se o vencimento cai no sábado ou domingo,
   '' se cair, passo para a primeira segunda-feira
   If Weekday(DT) = 1 Then
   DT = DateAdd("d", 1, DT)
   Fim_semana = (Fim_semana + 1)
   ElseIf Weekday(DT) = 7 Then
   DT = DateAdd("d", 2, DT)
   Fim_semana = (Fim_semana + 2)
   End If
       rs("VencCheque") = DT
       rs("DataLanc") = Me.txtDataLanc
       rs("Taxa") = Me.txtTaxa
       
       rs.Update
   Next
   rs.Close
   db.Close
   Me.frm_LancChequeDetSub.Requery  'Atualiza o SubForm
   Me.btn_Diário.enabled = False
End Sub