XL 2019 Format de date VBA et intégration de formules

[Jeralpha]

Bonjour à tous,

Je suis (re)nouveau sur ce forum. Je cherche de l'aide sur un fichier contenant des macros que l'on avait construit ici même sur ce forum en 2008 !! Je suis actuellement en cours de reconstruction de ce fichier qui est un journal de caisse.
Il me manque quelques compétences pour arriver au bout !
J'espère trouver parmi vous, l'aide qui me permettra de terminer mon projet. Merci d'avance à tous.

Explications : le fichier est mensuel et regroupe plusieurs onglets identiques (caisses du midi et caisses du soir de 1 à 31). Le fichier actuel permet de tous additionner et classer le mois entier de par l'addition d'un coté et par l'action de 2 macros de l'autre.
Mon objectif est de pouvoir le traiter partiellement avec une date de départ et une date de fin.
Mon idée (qui n'est peut-être pas la meilleur) est de renseigner une cellule comme date de départ et une autre pour la date de fin. Puis de lancer les macros via un bouton de commande.
C'est déjà le cas sur le fichier mais il traite le mois entier, et la, je cale sur un problème de format de date visiblement.

Voici la partie du code qui me pose soucis !

Sub GW_lance_1a31()
Dim dtDateDeb As Date
Dim dtDateFin As Date


' <<<< Debut : Partie de procedure pour la periode du 01 au 31 du mois
' Recuperation de la date de debut et de fin de traitement
With Worksheets("Accueil")
dtDateDeb = "01/" & Format(Sheets(1).Range("C4").Value, "dd/mm/yyyy")
dtDateFin = "31/" & Format(Sheets(1).Range("C5").Value, "dd/mm/yyyy")
End With

D'autre part, je voudrais en profiter pour intégrer cette formule dans le code pour une petite vingtaine de cellules : "=SOMME('01:31'!H20)+SOMME('01:31'!H55)"
et toujours en intégrant le fait de pouvoir le traiter partiellement.

Je joins mon fichier pour exemple
Merci de votre aide.

 

[Robert]

Bonjour Jeralpha, bonjour le forum,

Pour ton premier problème essaie comme ça :

With Worksheets("Accueil")
    dtDateDeb = Format(DateSerial(Year(.Range("C4").Value), Month(.Range("C4").Value), 1), "dd/mm/yyyy")
    dtDateFin = Format(DateSerial(Year(dtDateDeb), Month(dtDateDeb) + 1, 0), "dd/mm/yyyy")
End With

 

[Jeralpha]

Bonjour Robert,
Tout d'abord merci de votre aide.

Je viens de placer votre proposition dans le code.
La macro se lance sans problème mais malheureusement, elle prend en compte tout le fichier alors que je lui demande de s'arrêter au 2 juillet.
Le second module lui par contre ne se lance plus.

A bientôt

Jérôme

 

[Robert]

Re,

Pardon j'avais mal lu. Je croyais que c'est ça que tu voulais. Le code corrigé :

With Worksheets("Accueil")
    dtDateDeb = Format(DateSerial(Year(.Range("C4").Value), Month(.Range("C4").Value), Day(.Range("C4").Value)), "dd/mm/yyyy")
    dtDateFin = Format(DateSerial(Year(.Range("C5").Value), Month(.Range("C5").Value), Day(.Range("C5").Value)), "dd/mm/yyyy")
End With

 

[Jeralpha]

Cool, merci Robert, ça marche très bien sur la partie chèque mais je n'ai plus rien sur la partie "refacturation" ainsi que "sortie de caisse".
Il me semble bien avoir changé ce qu'il fallait mais il faut croire que non. Il y a quelque chose qui m'échappe !

voila ce que donne le code en entier :

Sub GW_lance_1a31()
Dim dtDateDeb As Date
Dim dtDateFin As Date


Dim i As Integer, k As Integer, l As Integer, m As Integer, drapeau As Boolean
Dim ligne1 As Long, ligne2 As Long, ligne3 As Long, ligne4 As Long, ligne5 As Long, _
ligne6 As Long, ligne7 As Long, ligne16 As Long, ligne17 As Long, ligne18 As Long, _
ligne19 As Long, ligne20 As Long, ligne21 As Long, ligne22 As Long, ligne23 As Long, _
ligne24 As Long, ligne25 As Long, ligne26 As Long, ligne27 As Long, ligne28 As Long, _
ligne29 As Long, ligne30 As Long, ligne31 As Long, ligne32 As Long, ligne33 As Long, _
ligne34 As Long, ligne35 As Long, ligne36 As Long, ligne37 As Long, ligne38 As Long, _
ligne39 As Long, ligne40 As Long, ligne41 As Long, ligne42 As Long, ligne43 As Long, _
ligne44 As Long, ligne45 As Long, ligne46 As Long, ligne47 As Long, ligne48 As Long, _
ligne49 As Long, ligne50 As Long, ligne51 As Long, ligne52 As Long, ligne53 As Long, _
ligne54 As Long, ligne55 As Long, ligne56 As Long


ligne1 = 56: ligne2 = 56: ligne3 = 56: ligne4 = 56: ligne5 = 56: ligne6 = 56: _
ligne7 = 56: ligne8 = 56: ligne9 = 56: ligne10 = 56: ligne11 = 56: ligne12 = 56: _
ligne13 = 56: ligne14 = 56: ligne15 = 56: ligne16 = 56: ligne17 = 56: ligne18 = 56: _
ligne19 = 56: ligne20 = 56: ligne21 = 56: ligne22 = 56: ligne23 = 56: ligne24 = 56: _
ligne25 = 56: ligne26 = 56: ligne27 = 56: ligne28 = 56: ligne29 = 56: ligne30 = 56: _
ligne31 = 56: ligne32 = 56: ligne33 = 56: ligne34 = 56: ligne35 = 56: ligne36 = 56: _
ligne37 = 56: ligne38 = 56: ligne39 = 56: ligne40 = 56: ligne41 = 56: ligne42 = 56: _
ligne43 = 56: ligne44 = 56: ligne45 = 56: ligne46 = 56: ligne47 = 56: ligne48 = 56: _
ligne49 = 56: ligne50 = 56: ligne51 = 56: ligne52 = 56: ligne53 = 56: ligne54 = 56: _
ligne55 = 56: ligne56 = 56

With Sheets(Sheets.Count)
For i = 5 To 34

' mise en place de la recap REFACTURATION
drapeau = False
For J = 24 To 28
If Sheets(i).Range("Y" & J).Value > 0 Then
If drapeau = False Then
.Range("A" & ligne2) = Sheets(i).Range("O5")
drapeau = True
End If
.Range("C" & ligne2) = Sheets(i).Range("B" & J)
.Range("G" & ligne2) = Sheets(i).Range("G" & J)
.Range("J" & ligne2) = Sheets(i).Range("L" & J)
.Range("P" & ligne2) = Sheets(i).Range("Y" & J)
ligne2 = ligne2 + 1
End If
Next J
For J = 59 To 63
If Sheets(i).Range("Y" & J).Value > 0 Then
If drapeau = False Then
.Range("A" & ligne2) = Sheets(i).Range("O5")
drapeau = True
End If
.Range("C" & ligne2) = Sheets(i).Range("B" & J)
.Range("G" & ligne2) = Sheets(i).Range("G" & J)
.Range("J" & ligne2) = Sheets(i).Range("L" & J)
.Range("P" & ligne2) = Sheets(i).Range("Y" & J)
ligne2 = ligne2 + 1
End If
Next J
Next i









' <<<< D_but : Partie de procedure pour la periode du 01 au 31 du mois
' Recuperation de la date de debut et de fin de traitement
With Worksheets("Accueil")
dtDateDeb = Format(DateSerial(Year(.Range("C4").Value), Month(.Range("C4").Value), Day(.Range("C4").Value)), "dd/mm/yyyy")
dtDateFin = Format(DateSerial(Year(.Range("C5").Value), Month(.Range("C5").Value), Day(.Range("C5").Value)), "dd/mm/yyyy")
End With

' Recuperation du montant de tous les cheques
Call RecupererChq(dtDateDeb, dtDateFin)
' >>>> Fin : Partie de procedure pour la periode du 01 au 31 du mois
End With

End Sub
Function couleur(cel As Range)
couleur = cel.Interior.ColorIndex
End Function

Public Sub RecupererChq(dtDateDeb As Date, dtDateFin As Date)
' Recuperation de la date et du montant des chquess
Dim lgLigChq As Long
Dim lgColChq As Long
Dim lgWS As Long
Dim dtDate As Date
Dim strJour As String
Dim lgLig As Long
Dim lgCol As Long
Dim bTrouveWS As Boolean
Dim pass As Integer
' Ligne d'affichage
lgLigChq = 108 ' ö partir de la ligne 108 de la feuille "Recap"
lgColChq = 1 ' ö partir de la colonne A de la feuille "Recap"
' Effacer le contenu de la plage de cellules de BT10 ö CD76
pass = 0
' Boucle de la date de debut ö la date de fin
For dtDate = dtDateDeb To dtDateFin
strJour = Format(Day(dtDate), "00")
bTrouveWS = False
' Rechercher l'existence de la feuille du jour concerne
For lgWS = 1 To ThisWorkbook.Worksheets.Count
If Worksheets(lgWS).Name = strJour Then
bTrouveWS = True
Exit For
End If
Next lgWS
If bTrouveWS = True Then
With Worksheets(strJour)
If pass = 1 Then pass = 0: lgColChq = lgColChq + 2: sup = 0

' 1er bloc de chques entre les colonnes M13 et Y200
' Lignes de 13 ö 20
For lgLig = 13 To 20
' Colonnes de M ö V par pas de 3
For lgCol = 13 To 25 Step 3

' For lgCol = 13 To 22 Step 3
' If .Range("Y" & lgLig) <> 0 And .Cells(lgLig, lgCol) <> "" Then
If .Cells(lgLig, lgCol) <> "" Then
Cells(lgLigChq, lgColChq + sup).Value = dtDate
'Cells(lgLigChq, lgColChq + 1).Value = .Range("Y" & lgLig).Value
Cells(lgLigChq, lgColChq + 2 + sup).Value = .Cells(lgLig, lgCol).Value
lgLigChq = lgLigChq + 1
End If
' Les lignes ö afficher ne doivent pas d_passer la ligne 150
If lgLigChq > 150 Then
lgLigChq = 108
lgColChq = lgColChq + 2
sup = sup + 2
pass = pass + 1
End If
Next lgCol
Next lgLig
If pass = 1 Then pass = 0: lgColChq = lgColChq + 2: sup = 0

' 2me bloc de chques entre les cellules M48 et Y555
' Lignes de 48 ö 55
For lgLig = 48 To 55
' Colonnes de M ö V par pas de 3
' For lgCol = 13 To 22 Step 3
' If .Range("Y" & lgLig) <> 0 And .Cells(lgLig, lgCol) <> "" Then
For lgCol = 13 To 25 Step 3
If .Cells(lgLig, lgCol) <> "" Then
Cells(lgLigChq, lgColChq).Value = dtDate
' MsgBox lgColChq & " " & Cells(lgLigChq, lgColChq).Address
' Cells(lgLigChq, lgColChq + 1).Value = .Range("Y" & lgLig).Value
Cells(lgLigChq, lgColChq + 2).Value = .Cells(lgLig, lgCol).Value
lgLigChq = lgLigChq + 1
End If
' Les lignes ö afficher ne doivent pas d_passer la ligne 150
If lgLigChq > 150 Then
lgLigChq = 108
pass = pass + 1
lgColChq = lgColChq + 2
End If
If pass = 1 Then pass = 0: lgColChq = lgColChq + 2
Next lgCol
Next lgLig
End With
End If
Next dtDate
End Sub

 

[Staple1600]

Bonsoir le fil, Jeralpha, Robert

Pour le fun, une variante pour déterminer le 1er jour et le dernier jour du mois par rapport à une date saisie dans une cellule (ici en C4 comme dans l'exemple du message#1)

Sub test()
Set f = Sheets("Accueil")
dtDateDeb = f.[C4] - Day(f.[C4]) + 1
dtDateFin = CDate(Application.EoMonth(f.[C4], 0))
MsgBox "Date début: " & dtDateDeb & vbCrLf & "Date début: " & dtDateFin, vbInformation, "Test"
End Sub

 

[Robert]

Bonjour le fil, bonjour le forum,

Désolé Jeralpha mais j'ai la flemme de travailler sur un code aussi long et dont je ne vois absolument pas ou tu veux en venir...

 

[Jeralpha]

Bonsoir le fil, Jeralpha, Robert

Pour le fun, une variante pour déterminer le 1er jour et le dernier jour du mois par rapport à une date saisie dans une cellule (ici en C4 comme dans l'exemple du message#1)

Sub test()
Set f = Sheets("Accueil")
dtDateDeb = f.[C4] - Day(f.[C4]) + 1
dtDateFin = CDate(Application.EoMonth(f.[C4], 0))
MsgBox "Date début: " & dtDateDeb & vbCrLf & "Date début: " & dtDateFin, vbInformation, "Test"
End Sub

 

[Jeralpha]

Bonjour Robert, Staple1600 et tous,

Pour te répondre Staple1600, et merci tout d'abord de m'avoir aidé, j'ai inséré la partie que tu m'as envoyée.
La macro se lance, mais la date de fin est celle du dernier jour du mois.
Mon objectif étant de traiter partiellement les données (exemple du 1au 2 du mois).

C'est en me basant sur le code de Robert que cela fonctionne bien mais en le modifiant légèrement par :


With Worksheets("Accueil")
dtDateDeb = Format(DateSerial(Year(.Range("C4").Value), Month(.Range("C4").Value), Day(.Range("C4").Value)), "dd/mm/yyyy")
dtDateFin = Format(DateSerial(Year(.Range("C5").Value), Month(.Range("C5").Value), Day(.Range("C5").Value)), "dd/mm/yyyy")
End With

Ce que je voulais expliquer Robert, c'est que le reste du code ne fonctionne plus.
Et mon niveau débutant en VBA ne permet pas de trouver pourquoi.
Je te rejoint, poster tout le code n'était peut être pas la meilleur solution pour être clair et sans doute bien décourageante !! désolé !

Voila donc ou j'en suis :
Un ancien code qui fonctionne auquel on vient d'ajouter une modification pour faire un calcul partiel.
L'idée première de cette macro est de classer dans un onglet de récap, des "chèques" dans l'ordre des jours saisis, ainsi que des informations de "Refacturation" et de "Sortie de caisse".

Suite à la modification du code :
La sélection partielle fonctionne
Le classement des chèques fonctionne
Mais la partie "Refacturation" et "sortie de caisse" ne fonctionnent plus.

Ma deuxième problématique seras l'addition de données de ce type : En se basant sur la date de début et date de fin mis en place, addition des cases (exemple A1) de tous les onglets de saisies de caisse (nommés de 01à 31).

Voila, j'espère avoir été plus explicite cette fois.

Merci encore

Bon dimanche à tous !

 

[Staple1600]

Re

Mon code était à titre indicatif (en espérant que cel pourrait t'interesser ou tout autre lecteur de ton fil)
C'est pour cela que j'avais ecrit: pour le fun

 

[Jeralpha]

ok bien compris. Je l'avais bien pris comme ça. Merci en tout cas !