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