Ne pas recalculer les functions d'un module lors de l'execution d'une macro

[kaiser]

Re bonjour

Voila sur une feuille j'ai un programme en VBA qui ,en fonction de la couleur des cases, va remplir un fichier annexe (en demandant deux infos via un inputbox) puis l'enregistrer sur une autre nom.

Private Sub CommandButton1_Click()

Dim Cell As Range
Dim flag As Boolean

feuille = ActiveSheet.Name
Application.ScreenUpdating = False

For n = 9 To Range("B65536").End(xlUp).Row Step 3
If n = 30 Then n = 33
Workbooks.Open "c:\Documents And Settings\diaquint\My Documents\rpl.xls"
Workbooks("2007Schicht2modif1.xls").Activate
Set plage_date = Range("D" & n & ":AG" & n)

i = 6

   For Each Cell In plage_date
    If Cell.Interior.ColorIndex = 6 Or Cell.Interior.ColorIndex = 38 Then
    Application.ScreenUpdating = True
    If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = True
    flag = True
        
    i = i + 1
    nom = Range("B" & n)
    prenom = Range("B" & n + 1)
    Workbooks("rpl.xls").Sheets("sheet1").Range("E4") = prenom & " " & nom
    Workbooks("rpl.xls").Sheets("sheet1").Range("E4").Borders.LineStyle = xLineStyleNone
    Workbooks("rpl.xls").Sheets("sheet1").Range("E28") = "Fait le " & Date
    Workbooks("rpl.xls").Sheets("sheet1").Range("E28").Font.Bold = True
    heure = Cell.Value
    jour = Cells(6, Cell.column)
     Application.ScreenUpdating = False
         Select Case feuille
         .....
         End Select
         
    Workbooks("rpl.xls").Worksheets("sheet1").Range("G3") = mois
    With Workbooks("rpl.xls").Worksheets("sheet1").Range("G3").Font
    .Bold = False
    .Italic = False
    .Underline = False
    End With
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 2) = heure
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 4) = jour & " " & mois

    remplace = InputBox("Entrez le nom de la personne remplacée le " & jour & " " & mois & " par " & prenom & " " & nom, "Remplacement", lastname, 9960, 330)
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 5) = remplace
    lastname = remplace
    If Cell.Interior.ColorIndex = 38 Then
    poste = "Neutra"
    Else
    poste = InputBox("Entrez le poste", "Remplacement", lastposte, 9960, 330)
    lastposte = poste
    End If
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 6) = poste
    'explication = InputBox("Entrez les explications du remplacement", "Remplacement", "", 9960, 330)
    'Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 7) = explication
    If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = False
 End If
Next Cell
If flag Then
Workbooks("rpl.xls").Activate
Workbooks("rpl.xls").SaveAs Filename:="remplacement " & mois & " " & nom
End If
flag = False
Next n
Workbooks("2007Schicht2modif1.xls").Activate
Workbooks("rpl.xls").Close
Application.ScreenUpdating = True
reponse = MsgBox("Voulez-vous imprimer les fiches de remplacements?", vbYesNo + vbQuestion, "Impression Fiche de Remplacement")
If reponse = 6 Then
If reponse = 7 Then

End If
End If
End Sub

Seulement sur cette même feuille j'ai également 3 fonctions écrites dans un module qui permettent de faire la somme en fonction de la couleur de la case/de la police.

Function sum_color(plage As Range, couleur_int As Integer) As Integer
    Dim gw_cel As Range, nb As Integer
    'Application.Volatile
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex = couleur_int Then nb = nb + gw_cel.Value
    Next
    sum_color = nb
End Function

Function sum_font_color(plage_date As Range, plage As Range, couleur_font As Integer) As Integer
    'Application.Volatile
    Dim gw_cel As Range, nb As Byte
    nb = 0
    For Each gw_cel In plage
        If Cells(plage_date.Row, gw_cel.column).Interior.ColorIndex = -4142 And gw_cel.Font.ColorIndex = couleur_font Then nb = nb + gw_cel.Value
    Next
    sum_font_color = nb
End Function

Function sum_nuits(plage_date As Range, plage As Range, couleur_int As Integer, couleur_font As Integer)
    'Application.Volatile
    Dim gw_cel As Range, nb As Byte
    nb = 0
    For Each gw_cel In plage
        If Cells(plage_date.Row, gw_cel.column).Interior.ColorIndex = couleur_int And gw_cel.Font.ColorIndex = couleur_font Then nb = nb + gw_cel.Value
    Next
    sum_nuits = nb
End Function

Le probléme qui se pose c'est que lors de l'éxécution de la macro, il recalcule en permanence les fonctions ce qui ralentit énormément le déroulement de la macro: cela est du a la ligne "application.volatile" qui fais qu'il recalcule a chaque regeneration de la page, mais si je supprime le "application.volatile", la les fonctions ne sont plus du tout recalculées!

Merci de votre aide

 

[kaiser]

Re : Ne pas recalculer les functions d'un module lors de l'execution d'une macro

Salut

y a pas une erreur dans ce que t'as ecris au dessus? parceque si par défaut les variables booléennes sans False, c'est pas logique que si on met rien ce soit égal à True nan?

Ptit up pour que j'arrive à imprimer mes fichiers

 

[Gorfael]

Re : Ne pas recalculer les functions d'un module lors de l'execution d'une macro

Salut

y a pas une erreur dans ce que t'as ecris au dessus? parceque si par défaut les variables booléennes sans False, c'est pas logique que si on met rien ce soit égal à True nan?

Ptit up pour que j'arrive à imprimer mes fichiers

Salut
C'est la valeur de la variable que est analysée
Pour clarifier, on va dire que 0 correspond à false et 1 à true

si Flag = true (1) l'expression (flag=True) renvoie une valeur logique 1 (true)
si Flag = false (0) l'expression (flag=True) renvoie une valeur logique 0 (false)

Mais si tu regardes de plus près, tu vois que la valeur finale est la même quand tu utilises l'expression ou la variable

Attention : Ce que je dit n'est pas entièrement vrai : une variable booléenne est codée sur 1 octet :
Vrai : 1111 1111 (FF) = -1 (et pas 1)
Faux : 0000 0000 (00) = 0
Mais ceci n'est valable qu'en VBA. Dans les formules, la valeur logique Faux est "0" et la valeur vrai est "<>0" (à condition que ce soit un nombre)

A+

 

[kaiser]

Re : Ne pas recalculer les functions d'un module lors de l'execution d'une macro

ok, merci bien pour ce petit cours de vba

t'aurais pas une idée pour mon autre probléme: https://www.excel-downloads.com/threads/imprimer-fichier-cree-par-un-programme-vba.76701/