Workbook_BeforePrint déclenche Worksheet_Calculate

[cibleo]

Bonsoir le forum,

Dans le ThisWorkbook, j'ai placé ce code de mise en page.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Ws As Worksheet, DateJour As String
Application.ScreenUpdating = False
DateJour = Format(Now, "dddd dd mmmm yyyy à hh:mm")
Set Ws = ActiveSheet
If Ws.Name = "Individuel" Or Ws.Name = "PlanningGardes" Then
  Ws.PageSetup.CenterFooter = "&""Verdana,Normal""&12Imprimé le " & DateJour
  Ws.PageSetup.RightFooter = "&""Verdana,Normal""&12Page &P sur &N page"
  If Ws.Name = "PlanningGardes" Then
    Ws.PageSetup.LeftFooter = "&""Verdana,Normal""&12Planning de Gardes"
  Else
    Ws.PageSetup.LeftFooter = "&""Verdana,Normal""&12Planning de " & Range("L3").Value
  End If
End If
Set Ws = Nothing
Application.ScreenUpdating = True
End Sub

Lors d'un aperçu avant impression, je me suis apercu qu'il déclenchait l'événement ci-dessous :

Private Sub Worksheet_Calculate()
Dim k As Range, c As Range, rng As Range
Set rng = Union(Range("D10:P15"), Range("R10:AD15"), Range("D17:P23"), Range("R17:AD23"), _
Range("D28:P30"), Range("R28:AD30"), Range("D32:P34"), Range("R32:AD34"))
If ActiveCell.Address = "$B$6" Then
  Application.ScreenUpdating = False
  For Each k In Range(Range("ChampEmployes1"))
    k.Interior.ColorIndex = xlNone
    k.Borders.LineStyle = xlLineStyleNone
    For Each c In Range("MFCEmployes1")
      If UCase(k.Value) = UCase(c.Value) Then
        k.Interior.ColorIndex = c.Interior.ColorIndex
        If k.Value = "Pascal" Then
          k.BorderAround 1, xlMedium, 1
        End If
        If k.Value = "Sylvie" Then
          k.BorderAround 1, xlThin, 1
        End If
      End If
    Next c
  Next k
  rng.BorderAround 1, xlThin, 1
  Application.ScreenUpdating = True
End If
End Sub

En B6, figure une liste de validation.
La cellule active étant hors B6, le BeforePrint s'exécute normalement malgré le déclenchement intempestif de calculate.
Par contre, cela provoque un plantage lorsque la cellule active est B6 :

Private Sub Worksheet_Calculate()
Dim k As Range, c As Range, rng As Range
.../...
If ActiveCell.Address = "$B$6" Then
.../...

Comment éviter le déclenchement de Worksheet_Calculate quand j'exécute Workbook_BeforePrint ?
Avez-vous déjà rencontrer ce problème ?

Cibleo

Ps : je souhaite garder l'événement Calculate, car le résultat obtenu avec l'événement Change ou SelectionChange n'était pas très convaincant. (obligé de cliquer plusieurs fois pour obtenir le mise en forme souhaitée)

 

[kiki29]

Salut,peut-être en encadrant la procédure concernée par

    Application.Calculate = xlManual
    ..........
    Application.Calculate = xlAutomatic

 

[cibleo]

Re : Workbook_BeforePrint déclenche Worksheet_Calculate

Bonjour Kiki29 et merci,
Bonjour à tous,

Dans l'événement Worksheet_Calculate, j'ai donc rajouté ceci comme suggéré par kiki29 :

Sheets("PlanningGardes").EnableCalculation = False
.../...
Sheets("PlanningGardes").EnableCalculation = True

Private Sub Worksheet_Calculate()
Dim k As Range, c As Range, rng As Range
Set rng = Union(Range("D10:P15"), Range("R10:AD15"), Range("D17:P23"), Range("R17:AD23"), _
Range("D28:P30"), Range("R28:AD30"), Range("D32:P34"), Range("R32:AD34"))
If ActiveCell.Address = "$B$6" Then
  Sheets("PlanningGardes").EnableCalculation = False
  Application.ScreenUpdating = False
  For Each k In Range(Range("ChampEmployes1"))
    k.Interior.ColorIndex = xlNone
    k.Borders.LineStyle = xlLineStyleNone
    For Each c In Range("MFCEmployes1")
      If UCase(k.Value) = UCase(c.Value) Then
        k.Interior.ColorIndex = c.Interior.ColorIndex
        If k.Value = "Pascal" Then
          k.BorderAround 1, xlMedium, 1
        End If
        If k.Value = "Sylvie" Then
          k.BorderAround 1, xlThin, 1
        End If
      End If
    Next c
  Next k
  rng.BorderAround 1, xlThin, 1
  Vacances_Scolaires_ZoneB
  Application.ScreenUpdating = True
  Sheets("PlanningGardes").EnableCalculation = True
End If
End Sub

Désormais, l'événement Workbook_BeforePrint ne déclenche plus Worksheet_Calculate et il n'y plus plus de plantage.

Inconvénient : la liste de validation placée en B6 ne déclenche plus Worksheet_Calculate, je suis obligé de passer par la touche F9

If ActiveCell.Address = "$B$6" Then

Y a t-il une autre alternative au cas où ?
Cibleo