Cliquer pour accélérer codes
s
Bonjour,
J'ai du code qui fonctionne bien mais qui est un peu long en éxecution.
J'ai remarqué que si je reclique une fois, cela execute l'opération rapidement sinon le traitement prend plus de temps.
Avez vous svp une explication?
Je vous remercie
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
If Sheets("Utilisateur").Range("b1") = 0 Then
MsgBox "Connectez Vous svp": Exit Sub
End If
Dim nomfeuille As String: Dim col4 As Integer: Dim lig4 As Integer: Dim ligchgt As Integer
nomfeuille = ActiveSheet.Name
Dim motif As String: Const xRg As String = "e57:nz250": Dim strOld As String: Dim strNew As String: Dim strCmt As String
Dim xLen As Long: Dim colchgt As Integer: Dim nomr As String: Dim dateR As Date: Dim numres As Integer: Dim motif1 As String
colchgt = Target(1).Column: ligchgt = Target(1).Row
If colchgt = 5 Then colchgt = 6
nomr = Worksheets("Stats repas").Cells(ligchgt, 1): dateR = Worksheets("Stats repas").Cells(55, ActiveCell.Column)
numres = Worksheets("Stats repas").Cells(ligchgt, 3)
If Code_Archive = 0 And ActiveCell.Row < 239 Then
With Target(1)
col4 = Target(1).Column: lig4 = Target(1).Row: Dim dd3 As String
If Intersect(.Cells, Range(xRg)) Is Nothing Then Exit Sub
motif = Cells(lig4, 2)
dd3 = Cells(55, col4): motif1 = .Text
End With
' Enregistrer détails du changement dans log14
Worksheets("log14").Activate: Worksheets("log14").Range("A1").Select: Selection.EntireRow.Insert 'Aller en A1 et'Insérer une ligne vide
strCmt = Sheets("Utilisateur").Range("a1") & " le " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & Chr(10) & "a saisi (" & motif1 & ") pour " & nomr & " (" & motif & ")" & " le " & dd3
ActiveCell = strCmt: ActiveCell.Offset(0, 1) = Sheets("Utilisateur").Range("a1")
ActiveCell.Offset(0, 2) = Format$(Now, "dd Mmm YYYY hh:nn:ss")
ActiveCell.Offset(0, 3) = numres: ActiveCell.Offset(0, 4) = dd3
Worksheets(nomfeuille).Activate
Dim Code14 As String: Code14 = "B"
Call ReglesResPVisible(numres, colchgt, Code14) 'calcul des présences FH selon regles de presences dans feuille
If numres <> "22" And numres <> "23" And numres <> "24" Then 'And numres <> "21" Then 'idem calcul présences repas sans les externes et Loic
Call ReglesRepasP1Visible(numres, colchgt, Code14)
End If
'Repas CI Quentin Aude le lundi soir si wB en CI
If (numres = 14 Or numres = 10 Or numres = 11) And Cells(177, colchgt) = "CI" And Format(Worksheets("Stats repas").Cells(55, colchgt), "w", 2) = 1 Then
If Cells(141, colchgt) = 1 Then Cells(144, colchgt) = "CI": Call ReglesRepasP1Visible(10, colchgt, Code14)
If Cells(150, colchgt) = 1 Then Cells(153, colchgt) = "CI": Call ReglesRepasP1Visible(11, colchgt, Code14)
End If
If (numres = 14 Or numres = 10 Or numres = 11) And Cells(177, colchgt) <> "CI" And Format(Worksheets("Stats repas").Cells(55, colchgt), "w", 2) = 1 Then
If Cells(144, colchgt) = "CI" Then Cells(144, colchgt) = "": Call ReglesRepasP1Visible(10, colchgt, Code14)
If Cells(153, colchgt) = "CI" Then Cells(153, colchgt) = "": Call ReglesRepasP1Visible(11, colchgt, Code14)
End If
' Repas CI Aude le vendredi soir si wB en CI
If (numres = 14 Or numres = 10 Or numres = 11) And Cells(177, colchgt) = "CI" And Format(Worksheets("Stats repas").Cells(55, colchgt), "w", 2) = 5 Then
If Cells(141, colchgt) = 1 Then Cells(144, colchgt) = "CI": Call ReglesRepasP1Visible(10, colchgt, Code14)
End If
If (numres = 14 Or numres = 10 Or numres = 11) And Cells(177, colchgt) <> "CI" And Format(Worksheets("Stats repas").Cells(55, colchgt), "w", 2) = 5 Then
If Cells(144, colchgt) = "CI" Then Cells(144, colchgt) = "": Call ReglesRepasP1Visible(10, colchgt, Code14)
End If
' idem Si on modifie présences WB jour+1
If (numres = 14 Or numres = 10 Or numres = 11) And Cells(177, colchgt - 1) = "CI" And Format(Worksheets("Stats repas").Cells(55, colchgt - 1), "w", 2) = 5 Then
If Cells(141, colchgt - 1) = 1 Then Cells(144, colchgt - 1) = "CI"
Call ReglesRepasP1Visible(10, colchgt - 1, Code14): Call ReglesRepasP1Visible(10, colchgt, Code14)
End If
If (numres = 14 Or numres = 10 Or numres = 11) And Cells(177, colchgt - 1) <> "CI" And Format(Worksheets("Stats repas").Cells(55, colchgt - 1), "w", 2) = 5 Then
If Cells(144, colchgt - 1) = "CI" Then Cells(144, colchgt - 1) = ""
Call ReglesRepasP1Visible(10, colchgt - 1, Code14): Call ReglesRepasP1Visible(10, colchgt, Code14)
End If
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
ActiveWindow.DisplayWorkbookTabs = True ': Application.DisplayFullScreen = True
End SubPUIS sous procédures
Sub ReglesResPVisible(numres As Integer, colchgt As Integer, Code14 As String) ' => enlever numP si possible
'Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False: ActiveSheet.DisplayPageBreaks = False: Application.DisplayAlerts = False: Application.EnableEvents = False
Dim DerCol As Integer, col As Integer: Dim ligneR As Integer: Dim LigneESAT As Integer: Dim chgtD As Integer: Dim chgtF As Integer: Dim Rp As Integer
If Code14 = "B" Then ' Si demande de la feuille Stats repas_change("B")
If colchgt < 5 Then '12 à 350
chgtD = 5: chgtF = 373
Else
chgtD = colchgt - 1: chgtF = colchgt + 1
If numres = 21 Then
chgtD = colchgt: chgtF = colchgt
End If
End If
ElseIf Code14 = "E" Then ' Si demande de Userform ReglesResident
chgtD = colchgt: chgtF = colchgt + 7
Else ' ou Pour tous : Workbook_Open("A") ou Calendrier ("A") ou ellipse3 ??? ou AUtre???
If colchgt = 4 Then
chgtD = 5: chgtF = 375
Else
chgtD = colchgt - 1: chgtF = colchgt + 20 'Période de jour -1 à jour +45 (workbook_open)
End If
End If
If chgtF > 376 Then chgtF = 377 'si colonne > a la colonne de la dernier date de l'année
With Sheets("Fiche_Resident") 'Récupère infos du résident dans la feuille Fiche_Resident
ligneR = .Cells(numres + 3, 4): LigneESAT = .Cells(numres + 3, 8): Sta = .Cells(numres + 3, 5)
End With
If Sta = "FV" Then ligneR = ligneR - 2 'If ligneR > 197 Then ligneR = ligneR - 2
If Sta = "NUIT" Then ligneR = ligneR - 1 'Loic
With Sheets("Stats repas")
For col = chgtD To chgtF
If Sta = "FH" Or Sta = "AT" Or Sta = "NUIT" Or Sta = "EXT" Then 'If ligneR < 198 Or ligneR = 221 Then
If CDate(Sheets("2022").Cells(5, col + 8)) = CDate(Sheets("Stats repas").Cells(55, col)) Then
If numres = 21 Then 'si Loic
Sheets("Stats repas").Cells(ligneR + 1, col) = Sheets("2022").Cells(LigneESAT, col + 8)
'If Sheets("Stats repas").Cells(ligneR + 1, col) = 1 Or Sheets("Stats repas").Cells(ligneR + 1, col) = 2 Then
' Sheets("Stats repas").Cells(ligneR + 3, col) = 1
'Else
' Sheets("Stats repas").Cells(ligneR + 3, col) = 0
'End If
Else
If col > 4 Then
Sheets("Stats repas").Cells(ligneR, col) = Sheets("2022").Cells(LigneESAT, col + 8) 'note infos Esat dans Stats
End If
If numres = 22 Or numres = 23 Or numres = 25 Then 'Repas des externes
If Sheets("Stats repas").Cells(ligneR, col) = 1 Or Sheets("Stats repas").Cells(ligneR, col) = 2 Then
Sheets("Stats repas").Cells(ligneR + 1, col) = 1
Else
Sheets("Stats repas").Cells(ligneR + 1, col) = 0
End If
End If
If numres = 24 Then 'Jean Michel Repas seulemet Lundi
If Format(.Cells(55, col), "w", 2) = 1 Then
If Sheets("Stats repas").Cells(ligneR, col) = 1 Or Sheets("Stats repas").Cells(ligneR, col) = 2 Then
Sheets("Stats repas").Cells(ligneR + 1, col) = 1
Else
Sheets("Stats repas").Cells(ligneR + 1, col) = 0
End If
Else
Sheets("Stats repas").Cells(ligneR + 1, col) = 0
End If
End If
End If
If numres < 20 And numres <> 6 Then 'sauf stephane marjorie Loic et externes=> enleve < et > si besoin et noter FH
'Présent au FH si 1 seul jour de congé dans la semaine entre des journées de travail
If (numres < 17 And numres <> 11 And numres <> 3 And numres <> 5 And numres <> 6 And numres <> 12) And (Sheets("Stats repas").Cells(ligneR + 2, col) <> ">" And Sheets("Stats repas").Cells(ligneR + 2, col) <> "<") And (Sheets("Stats repas").Cells(ligneR, col) <> 1 Or Sheets("Stats repas").Cells(ligneR, col) <> 2) And (Sheets("Stats repas").Cells(ligneR, col - 1) = 1 Or Sheets("Stats repas").Cells(ligneR, col - 1) = 2) And (Sheets("Stats repas").Cells(ligneR, col + 1) = 1 Or Sheets("Stats repas").Cells(ligneR, col + 1) = 2) Then Sheets("Stats repas").Cells(ligneR + 2, col) = "x"
Dim CC14 As Integer
If numres = 13 Or numres = 8 Or numres = 10 Or numres = 2 Or numres = 16 Then
CC14 = Format(CDate(Sheets("Stats repas").Cells(55, col)), "w", 2)
' Présent au FH les jours de congés en semaine si il travaille le weekend
If CDate(Sheets("Stats repas").Cells(55, col)) > "28/12/2021" And (Sheets("Stats repas").Cells(ligneR, col + 7 - CC14) = 2 Or Sheets("Stats repas").Cells(ligneR, col + 6 - CC14) = 2) And Format(CDate(Sheets("Stats repas").Cells(55, col)), "w", 2) < 6 Then
If Sheets("Stats repas").Cells(ligneR + 2, col) <> "x" Or Sheets("Stats repas").Cells(ligneR + 2, col) <> "x>" Or Sheets("Stats repas").Cells(ligneR + 2, col) <> "x<" Or Sheets("Stats repas").Cells(ligneR, col) <> 1 Or Sheets("Stats repas").Cells(ligneR, col) <> 2 Then
Sheets("Stats repas").Cells(ligneR + 2, col) = "x"
End If
End If
End If
If numres = 15 And (CDate(Sheets("Stats repas").Cells(55, col)) < "15/08/2022" Or CDate(Sheets("Stats repas").Cells(55, col)) > "18/08/2022") Then
CC14 = Format(CDate(Sheets("Stats repas").Cells(55, col)), "w", 2)
' Présent au FH les jours de congés en semaine si il travaille le weekend
If CDate(Sheets("Stats repas").Cells(55, col)) > "28/12/2021" And (Sheets("Stats repas").Cells(ligneR, col + 7 - CC14) = 2 Or Sheets("Stats repas").Cells(ligneR, col + 6 - CC14) = 2) And Format(CDate(Sheets("Stats repas").Cells(55, col)), "w", 2) < 6 Then
If Sheets("Stats repas").Cells(ligneR + 2, col) <> "x" Or Sheets("Stats repas").Cells(ligneR + 2, col) <> "x>" Or Sheets("Stats repas").Cells(ligneR + 2, col) <> "x<" Or Sheets("Stats repas").Cells(ligneR, col) <> 1 Or Sheets("Stats repas").Cells(ligneR, col) <> 2 Then
Sheets("Stats repas").Cells(ligneR + 2, col) = "x"
End If
End If
End If
If Sheets("Stats repas").Cells(ligneR, col) = 1 Or Sheets("Stats repas").Cells(ligneR, col) = 2 Then 'Si travaille alors afficher seulement > ou <
If Sheets("Stats repas").Cells(ligneR + 2, col) = "x" Then Sheets("Stats repas").Cells(ligneR + 2, col) = ""
If Sheets("Stats repas").Cells(ligneR + 2, col) = "x>" Then Sheets("Stats repas").Cells(ligneR + 2, col) = ">"
If Sheets("Stats repas").Cells(ligneR + 2, col) = "x<" Then Sheets("Stats repas").Cells(ligneR + 2, col) = "<"
End If
If Sheets("2022").Cells(LigneESAT, col + 8) = 0 And (Sheets("Stats repas").Cells(ligneR + 2, col) = "x" Or Sheets("Stats repas").Cells(ligneR + 2, col) = "x>" Or Sheets("Stats repas").Cells(ligneR + 2, col) = "x<") Then
Sheets("Stats repas").Cells(ligneR + 1, col) = "FH"
ElseIf Sheets("2022").Cells(LigneESAT, col + 8) > 2 And (Sheets("Stats repas").Cells(ligneR + 2, col) = "x" Or Sheets("Stats repas").Cells(ligneR + 2, col) = "x>" Or Sheets("Stats repas").Cells(ligneR + 2, col) = "x<") Then
Sheets("Stats repas").Cells(ligneR + 1, col) = "FH"
Else
Sheets("Stats repas").Cells(ligneR + 1, col) = Sheets("2022").Cells(LigneESAT, col + 8)
End If
End If
If numres = 6 Then 'note Marjorie présente du lundi au mercredi si elle travaille
If Format(CDate(Sheets("Stats repas").Cells(55, col)), "w", 2) < 4 And Sheets("Stats repas").Cells(ligneR, col) = 1 Then Sheets("Stats repas").Cells(ligneR + 2, col) = "x"
'If Sheets("Stats repas").Cells(ligneR, col) = 1 Or Sheets("Stats repas").Cells(ligneR, col) = 2 Then
' Sheets("Stats repas").Cells(ligneR + 3, col) = 1
'Else
' Sheets("Stats repas").Cells(ligneR + 3, col) = 0
'End If
End If
If numres = 20 Or numres = 6 Then ' Si Stéphane et Marjorie AT
If (Sheets("Stats repas").Cells(ligneR + 2, col) = "x" Or Sheets("Stats repas").Cells(ligneR + 2, col) = "x>" Or Sheets("Stats repas").Cells(ligneR + 2, col) = "x<") Then
Sheets("Stats repas").Cells(ligneR + 1, col) = "AT"
Sheets("Stats repas").Cells(ligneR + 1, col).Interior.Color = RGB(255, 255, 0)
Else
Sheets("Stats repas").Cells(ligneR + 1, col) = Sheets("2022").Cells(LigneESAT, col + 8)
End If
End If
End If
End If
'Liste Horaires Salariés
Dim colFH11
'colFH11 = DatePart("y", CDate(Sheets("Stats repas").Cells(55, col))) + 9
For i = 4 To 747 ' Liste Salariés
If Sheets("Hsal").Cells(13, i) = CDate(Sheets("Stats repas").Cells(55, col)) Then
colFH11 = i: Exit For
End If
Next
Sheets("Stats repas").Cells(255, col) = Sheets("Hsal").Cells(73, colFH11 + 1)
Sheets("Stats repas").Cells(254, col) = Sheets("Hsal").Cells(72, colFH11 + 1)
Sheets("Stats repas").Cells(300, col) = Sheets("Hsal").Cells(129, colFH11 + 1)
Sheets("Stats repas").Cells(301, col) = Sheets("Hsal").Cells(128, colFH11 + 1)
Next col
End With
'Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True: ActiveSheet.DisplayPageBreaks = True: Application.DisplayAlerts = True: Application.EnableEvents = True
End Sub
Sub ReglesRepasP1Visible(numres As Integer, colchgt As Integer, Code14 As String) ' règles des ajouts modifs suppression des repas du resident selectionné pour Periode1 as integer, DF1 as integer
'Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False: ActiveSheet.DisplayPageBreaks = False: Application.DisplayAlerts = False: Application.EnableEvents = False
Dim col As Integer: Dim ligneR As Integer: Dim Jj As Integer: Dim chgtD As Integer: Dim chgtF As Integer: Dim Rp As Integer
If Code14 = "B" Then ' Si demande de la feuille Stats repas_change("B")
If colchgt < 5 Then '12 à 350
chgtD = 5: chgtF = 373
Else
chgtD = colchgt - 1: chgtF = colchgt + 1
If numres = 21 Then
chgtD = colchgt: chgtF = colchgt
End If
End If
ElseIf Code14 = "E" Then ' Si demande de Userform ReglesResident
chgtD = colchgt: chgtF = colchgt + 7
Else ' ou Workbook_Open("A") ou Calendrier ?? ou ellipse3 ??? ou AUtre???
If colchgt = 4 Then
chgtD = 5: chgtF = 375
Else
chgtD = colchgt - 1: chgtF = colchgt + 20 'Période de jour -1 à jour +45 (workbook_open)
End If
End If
If chgtF > 376 Then chgtF = 377
With Sheets("Fiche_Resident") 'Récupère infos du résident dans la feuille Fiche_Resident
ligneR = .Cells(numres + 3, 4): Sta = .Cells(numres + 3, 5)
End With
Dim TT1 As String: Dim TT2 As String
If Sta = "FV" Then ligneR = ligneR - 2 'If ligneR > 197 Then ligneR = ligneR - 2
If Sta = "NUIT" Then ligneR = ligneR - 1 'Loic
With Sheets("Stats repas")
For col = chgtD To chgtF
Dim RR6, RR7 As String: RR6 = .Cells(ligneR + 6, col): RR7 = .Cells(ligneR + 7, col)
For Jj = 1 To 7 'de Jour 1 à 7
If Format(.Cells(55, col), "w", 2) = Jj Then 'si même numéro de jour entre date de Stats repas et Jj
Dim AA1, CD, CF, RR, MM, SS As Integer
For AA1 = 1 To 3 'Définit les numéros de colonne de la feuille Fiche_Resident selon période 1 à 3
If AA1 = 1 Then CD = 19: CF = 20: RR = 12: MM = 20: SS = 27
If AA1 = 2 Then CD = 35: CF = 36: RR = 15: MM = 36: SS = 43
If AA1 = 3 Then CD = 51: CF = 52: RR = 18: MM = 52: SS = 59
If .Cells(55, col) >= Sheets("Fiche_Resident").Cells(numres + 3, CD) And .Cells(55, col) <= Sheets("Fiche_Resident").Cells(numres + 3, CF) Then
TT1 = .Cells(ligneR + 6, col): TT2 = .Cells(ligneR + 7, col) ': .Cells(ligneR + 6, col) = "": .Cells(ligneR + 7, col) = ""
Rp = Sheets("Fiche_Resident").Cells(numres + 3, RR): Call FormuleCode(Rp, col, ligneR) 'Appelle code formule
'***************** MIDI *****************
If .Cells(ligneR + 3, col) = 1 Then 'si 1 le midi
If numres = 2 And (Jj > 5) And (.Cells(ligneR, col) = 1 Or .Cells(ligneR, col) = 2) Then 'CI pour Daniel le weekend présent en congé
If TT1 <> "" And TT1 <> Sheets("Fiche_Resident").Cells(numres + 3, Jj + CF) Then .Cells(ligneR + 6, col) = TT1
ElseIf numres = 19 Then 'Frédérique le mardi midi
If Jj <> 2 And .Cells(ligneR + 2, col - 1) = "" Then
.Cells(ligneR + 6, col) = "F"
If TT1 <> "" And TT1 <> Sheets("Fiche_Resident").Cells(numres + 3, Jj + CF) Then .Cells(ligneR + 3, col) = "F"
End If
Else
If TT1 <> "" Then 'les autres
.Cells(ligneR + 6, col) = TT1
ElseIf Sheets("Fiche_Resident").Cells(numres + 3, Jj + CF) <> "" Then
.Cells(ligneR + 6, col) = Sheets("Fiche_Resident").Cells(numres + 3, Jj + CF).Value
End If
End If
End If
If RR6 = "1" Then .Cells(ligneR + 3, col) = 1
'***************** SOIR *****************
If .Cells(ligneR + 4, col) = 1 Then 'Si 1 le soir
If numres = 2 And Jj > 5 And (.Cells(ligneR, col) = 1 Or .Cells(ligneR, col) = 2) Then 'Thibaut
If TT2 <> "" And TT2 <> Sheets("Fiche_Resident").Cells(numres + 3, Jj + SS) Then .Cells(ligneR + 7, col) = TT2
ElseIf (numres = 10 Or numres = 11) And Jj = 1 Then 'Quentin et Aude le lundi soir si Wilfried CI
If .Cells(180, col) = "CI" Then
If TT2 <> "" And TT2 <> "CI" Then
.Cells(ligneR + 7, col) = TT2
Else
.Cells(ligneR + 7, col) = "CI"
End If
Else
If TT2 <> "" Then
.Cells(ligneR + 7, col) = TT2
Else
.Cells(ligneR + 7, col) = ""
End If
End If
ElseIf numres = 10 And Jj = 5 Then 'Aude le vendredi soir si Wilfried CI
If .Cells(180, col) = "CI" Then
If TT2 <> "" And TT2 <> "CI" Then
.Cells(ligneR + 7, col) = TT2
Else
.Cells(ligneR + 7, col) = "CI"
End If
Else
If TT2 <> "" Then
.Cells(ligneR + 7, col) = TT2
Else
.Cells(ligneR + 7, col) = ""
End If
End If
Else
If TT2 <> "" Then 'les autres
.Cells(ligneR + 7, col) = TT2
ElseIf Sheets("Fiche_Resident").Cells(numres + 3, Jj + SS) <> "" Then
.Cells(ligneR + 7, col) = Sheets("Fiche_Resident").Cells(numres + 3, Jj + SS).Value
End If
End If
End If
If RR7 = "1" Then .Cells(ligneR + 4, col) = 1
End If
Next
End If
Next
'Appel FormuleCode pour voir règle de présences mais pas pour les EXT et LOIC
If .Cells(55, col) >= Sheets("Fiche_Resident").Cells(numres + 3, 10) And .Cells(55, col) <= Sheets("Fiche_Resident").Cells(numres + 3, 11) Then
Rp = Sheets("Fiche_Resident").Cells(numres + 3, 12): Call FormuleCode(Rp, col, ligneR)
End If
If .Cells(55, col) >= Sheets("Fiche_Resident").Cells(numres + 3, 13) And .Cells(55, col) <= Sheets("Fiche_Resident").Cells(numres + 3, 14) Then
Rp = Sheets("Fiche_Resident").Cells(numres + 3, 15): Call FormuleCode(Rp, col, ligneR)
End If
If .Cells(55, col) >= Sheets("Fiche_Resident").Cells(numres + 3, 16) And .Cells(55, col) <= Sheets("Fiche_Resident").Cells(numres + 3, 17) Then
Rp = Sheets("Fiche_Resident").Cells(numres + 3, 18): Call FormuleCode(Rp, col, ligneR)
End If
Next col
End With
ActiveCell.Select
'Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True: ActiveSheet.DisplayPageBreaks = True: Application.DisplayAlerts = True: Application.EnableEvents = True
End SubCordialement
Invité
Bonjour Sylvainpyc
Je pense vous l'avoir déjà dit
et quand je vois le code
A+
s
Bonjour,
Je vous remercie de votre réponse
Mon fichier est beaucoup trop lourd pour le transférer.
Le code fonctionne même si je suis conscient qu'il ne doit pas être bien conforme aux règles d'un bon programmateur, j'ai appris seul.
Ce qui m'interroge, c'est que quand la procédure _change de la feuille "Stats repas" se lance, la procédure dure environ 10 secondes et si je reclique 1 fois la procédure dure environ 2 secondes.
Ce n'est pas dramatique mais je trouve ça étonnant et je n'arrive pas à comprendre la raison.
Je pensais que ca venait d'une ligne de ce bloc mais j'ai testé un peu tout et ca ne semble pas être ça.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = FalseCordialement
Invité
Re,
Et bien restez avec vos 2 clicks, c'est parfait... le second sera plus rapide
Bonne soirée
s
OK
Je vais continuer à chercher pour régler ce pb pour mes collègues qui utilisent ce fichier de gestion des présences des personnes handicapées du Foyer d'Hébergement ou je travaille.
Peut être essayer de créer un code qui simule un deuxième click ou plutôt revoir mon code.
J'ai essayé de supprimer un maximum de feuilles et de codes pour alléger le fichier mais je n'arrive à passer que de 6Mo à 3Mo donc pas suffisant pour atteindre le Mo.
Je vous remercie
Bonne soirée