Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

selection de pages pour une recap sous vba

brewen

XLDnaute Junior
Bonjour,

Ma question concerne un fichier qui sert à saisir des comptages de caisse de restaurant, sous forme de quinzaine.
exemple : 1ere quinzaine : 1 feuille de saisie par jour(14) puis une feuille de récap.
Il y a un code vba sous un bouton (sur la recap) qui vient chercher des infos sur les autres feuilles.
il prend les infos de toutes les feuilles, il est programmé pour.
Je voudrait savoir si il est possible de modifier le code en ayant la possibilité de selectionner les feuilles de notre choix pour la recap (ex : du 3 au 10)

voici une partie du code actuel avec la partie de selection des feuilles :

HTML:
<<<< Début : Partie de procédure pour la période du 01 au 14 du mois
' Récupération de la date de début et de fin de traitement
With Worksheets("Feuil1")
dtDateDeb = "01/" & Format(Sheets(1).Range("C4").Value, "mm/yyyy")
dtDateFin = "14/" & Format(Sheets(1).Range("C4").Value, "mm/yyyy")
End With

' Récupération du montant de tous les chèques
Call RecupererChq(dtDateDeb, dtDateFin)
' >>>> Fin : Partie de procédure pour la période du 01 au 14 du mois
End With

HTML:

Pouvez vous m'aider ?
Merci d'avance
 

skoobi

XLDnaute Barbatruc
Re : selection de pages pour une recap sous vba

Bonjour brewen,

Je voudrait savoir si il est possible de modifier le code en ayant la possibilité de selectionner les feuilles de notre choix pour la recap (ex : du 3 au 10)
Il suffit de faire une boucle sur ces feuilles:

Code:
For i = 3 to 10
With Sheets(i)
.........
...........
End With
Next
 

brewen

XLDnaute Junior
Re : selection de pages pour une recap sous vba

merci de ta reponse,

cela veut dire qu'il faut changer le code à chaque fois, ce qui est compliqué pour tous les collaborateurs qui utilise le fichier
maintenant si sur la feuille de recap il y a une cellule "date de depart" et une autre "date de fin", qui permette de faire une selection de certaines feuilles.
Quel serai le code?
 

skoobi

XLDnaute Barbatruc
Re : selection de pages pour une recap sous vba

Re,

pour toi qui est plongé dans ton projet, ça parait évident mais pas pour moi si tu vois ce que je veux dire...
Déjà, dans ton premier message, tu parles de plusieurs feuilles, or le bout de code que tu mets ne traite qu'une feuille...
Un beau fichier avec des explications serait le bien venu.
 

brewen

XLDnaute Junior
Re : selection de pages pour une recap sous vba

re,
je t'envoi le fichier. J'ai garder une seule feuille de saisie + la recap (faute d'espace) et voici le code en entier (que j'ai retiré egalement du fichier) et qui est placé en 2 modules :

module 1

Sub GW_lance_1a14()
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 = 2 To 16

' 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 procédure pour la période du 01 au 14 du mois
' Récupération de la date de début et de fin de traitement
With Worksheets("Feuil1")
dtDateDeb = "01/" & Format(Sheets(1).Range("C4").Value, "mm/yyyy")
dtDateFin = "14/" & Format(Sheets(1).Range("C4").Value, "mm/yyyy")
End With

' Récupération du montant de tous les chèques
Call RecupererChq(dtDateDeb, dtDateFin)
' >>>> Fin : Partie de procédure pour la période du 01 au 14 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)
' Récupération de la date et du montant des chèques
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 début à la date de fin
For dtDate = dtDateDeb To dtDateFin
strJour = Format(Day(dtDate), "00")
bTrouveWS = False
' Rechercher l'existence de la feuille du jour concerné
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 chèques entre les colonnes M13 et Y20
' 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 chèques entre les cellules M48 et Y55
' 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

module 2

Sub GW_lance_1a14()
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, ligne57 As Long, ligne58 As Long, _
ligne59 As Long, ligne60 As Long, ligne61 As Long, ligne62 As Long, ligne63 As Long, _
ligne64 As Long, ligne65 As Long, ligne66 As Long, ligne67 As Long, ligne68 As Long, _
ligne69 As Long, ligne70 As Long, ligne71 As Long, ligne72 As Long, ligne73 As Long, _
ligne74 As Long, ligne75 As Long, ligne76 As Long, ligne77 As Long, ligne78 As Long, _
ligne79 As Long, ligne80 As Long, ligne81 As Long, ligne82 As Long, ligne83 As Long, _
ligne84 As Long, ligne85 As Long, ligne86 As Long
ligne1 = 86: ligne2 = 86: ligne3 = 86: ligne4 = 86: ligne5 = 86: ligne6 = 86: ligne7 = 86 _
: ligne8 = 86: ligne9 = 86: ligne10 = 86: ligne11 = 86: ligne12 = 86: ligne13 = 86: ligne14 = 86 _
: ligne15 = 86: ligne16 = 86: ligne17 = 86: ligne18 = 86: ligne19 = 86: ligne20 = 86: ligne21 = 86 _
: ligne22 = 86: ligne23 = 86: ligne24 = 86: ligne25 = 86: ligne26 = 86: ligne27 = 86: ligne28 = 86 _
: ligne29 = 86: ligne30 = 86: ligne31 = 86: ligne32 = 86: ligne33 = 86: ligne34 = 86: ligne35 = 86 _
: ligne36 = 86: ligne37 = 86: ligne38 = 86: ligne39 = 86: ligne40 = 86: ligne41 = 86: ligne42 = 86 _
: ligne43 = 86: ligne44 = 86: ligne45 = 86: ligne46 = 86: ligne47 = 86: ligne48 = 86: ligne49 = 86 _
: ligne50 = 86: ligne51 = 86: ligne52 = 86: ligne53 = 86: ligne54 = 86: ligne55 = 86: ligne56 = 86 _
: ligne57 = 86: ligne58 = 86: ligne59 = 86: ligne60 = 86: ligne61 = 86: ligne62 = 86: ligne63 = 86 _
: ligne64 = 86: ligne65 = 86: ligne66 = 86: ligne67 = 86: ligne68 = 86: ligne69 = 86: ligne70 = 86 _
: ligne71 = 86: ligne72 = 86: ligne73 = 86: ligne74 = 86: ligne75 = 86: ligne76 = 86: ligne77 = 86 _
: ligne78 = 86: ligne79 = 86: ligne80 = 86: ligne81 = 86: ligne81 = 86: ligne82 = 86: ligne83 = 86 _
: ligne84 = 86: ligne85 = 86: ligne86 = 86

With Sheets(Sheets.Count)
For i = 2 To 16


' mise en place de la recap sotie de caisse
drapeau = False
For J = 32 To 34
If Sheets(i).Range("Y" & J).Value > 0 Then
If drapeau = False Then
.Range("A" & ligne3) = Sheets(i).Range("O5")
drapeau = True
End If
.Range("C" & ligne3) = Sheets(i).Range("B" & J)
.Range("H" & ligne3) = Sheets(i).Range("M" & J)
.Range("J" & ligne3) = Sheets(i).Range("P" & J)
.Range("L" & ligne3) = Sheets(i).Range("S" & J)
.Range("N" & ligne3) = Sheets(i).Range("V" & J)
.Range("P" & ligne3) = Sheets(i).Range("Y" & J)
ligne3 = ligne3 + 1
End If
Next J
For J = 67 To 69
If Sheets(i).Range("Y" & J).Value > 0 Then
If drapeau = False Then
.Range("A" & ligne3) = Sheets(i).Range("O5")
drapeau = True
End If
.Range("C" & ligne3) = Sheets(i).Range("B" & J)
.Range("H" & ligne3) = Sheets(i).Range("M" & J)
.Range("J" & ligne3) = Sheets(i).Range("P" & J)
.Range("L" & ligne3) = Sheets(i).Range("S" & J)
.Range("N" & ligne3) = Sheets(i).Range("V" & J)
.Range("P" & ligne3) = Sheets(i).Range("Y" & J)
ligne3 = ligne3 + 1
End If
Next J
Next i

End With


End Sub
 

Pièces jointes

  • Nouveau dossier compressé.zip
    30.5 KB · Affichages: 38
  • Nouveau dossier compressé.zip
    30.5 KB · Affichages: 37
  • Nouveau dossier compressé.zip
    30.5 KB · Affichages: 38

skoobi

XLDnaute Barbatruc
Re : selection de pages pour une recap sous vba

maintenant si sur la feuille de recap il y a une cellule "date de depart" et une autre "date de fin", qui permette de faire une selection de certaines feuilles.
Quel serai le code?

Et bien si la cellule "date de depart" est A1 et la cellule "date de fin" est B1:

Code:
  With Sheets(Sheets.Count)
   [COLOR=Blue][B] For i = .Range("A1").Value To .Range("B1").Value[/B][/COLOR]

      ' mise en place de la recap REFACTURATION
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…