MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Parcelamentos dias úteis

    avatar
    Anslu
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 88
    Registrado : 11/01/2018

    [Resolvido]Parcelamentos dias úteis Empty [Resolvido]Parcelamentos dias úteis

    Mensagem  Anslu em 1/8/2020, 03:01

    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
    avatar
    Anslu
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 88
    Registrado : 11/01/2018

    [Resolvido]Parcelamentos dias úteis Empty Re: [Resolvido]Parcelamentos dias úteis

    Mensagem  Anslu em 3/8/2020, 02:06

    Up
    avatar
    Anslu
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 88
    Registrado : 11/01/2018

    [Resolvido]Parcelamentos dias úteis Empty Re: [Resolvido]Parcelamentos dias úteis

    Mensagem  Anslu em 3/8/2020, 13:42

    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

      Data/hora atual: 30/11/2020, 04:30