Optimisation code VBA

Le 05/11/2020 à 23:02

Bonjour,

J'ai crée un fichier de Document Unique avec de nombreuses feuilles. J'y ai intégré du VBA. Celui fonctionne mais n'est je pense pas très optimisé

C'est pour cela que je fais appel à votre temps et connaissance.

J'ai un même code qui s'exécute sur plusieurs feuilles (PVC - Débit, PVC - Soudage, PVC - Assem. ferrures, PVC - Assem. Menuiserie, PVC - Vitrage-Expé, ALU - Débit, ALU - Assem. ferrures, ALU - Assem. Menuiserie, ALU - Vitrage)

- serait il possible d'utiliser "ThisWorkbook" afin d'avoir le code à un seul endroit avec l'option "SheetActivate"

Private Sub Worksheet_Activate()

'permet d'appeler une macro privée
Application.Run ("Miseenformeconditionnellle")

Dim DerLigne As Integer
'Si tu veux la dernière cellule en colonne A
DerLigne = Cells(Rows.Count, "A").End(xlUp).Row
'efface la mise en forme conditionnelle de la colonne I
Range("I8:I" & DerLigne).Select
Cells.FormatConditions.Delete

For i = 8 To DerLigne
       Range("F" & i).Formula = "=D" & i & "*" & "E" & i
       Range("I" & i).Formula = "=F" & i & "*" & "H" & i
       ' ecris la formule =SI(J8="";"OUI";"NON") 5 colonnes avant la valeur dans Range("O" & i)
       Range("O" & i).FormulaR1C1 = "=IF(RC[-5]="""",""OUI"",""NON"")"
Next
Range("O:O").EntireColumn.Hidden = True

'definition de la zone d'impression
ActiveSheet.PageSetup.PrintArea = "$A$1:$N$" & DerLigne
'definition du zoom de la feuille
ActiveWindow.Zoom = 80
Range("A8").Select

appName = "Document Unique"
appVersion = "1.01"
Application.StatusBar = appName & " (Version " & appVersion & ")"
End Sub

J'ai une autre macro qui me permet d'avoir une recap de toute les feuilles. "Synthese"

Sub Rectangle11_Clic()
Dim DerLigne As Integer
Dim nomagence As String
'EnableEvents pour désactiver provisoirement les évènements
Application.EnableEvents = False
'Application.ScreenUpdating = False
Worksheets("SYNTHESE").Activate
 [b4:H500].ClearContents
 'Sheets.count donne le nombre d'onglets du classeur actif
 For i = 3 To sheets.Count
   For lig = 2 To sheets(i).Range("A200").End(xlUp).Row
     If UCase(sheets(i).Cells(lig, "O")) = "NON" Then
       sheets(i).Cells(lig, 1).Resize(, 1).Copy Range("B1000").End(xlUp).Offset(1, 1) 'recopie la valeur de la colonne 1
       sheets(i).Cells(lig, 10).Resize(, 1).Copy Range("B1000").End(xlUp).Offset(1, 2) 'recopie la valeur de la colonne 10
       sheets(i).Cells(lig, 11).Resize(, 1).Copy Range("B1000").End(xlUp).Offset(1, 3) 'recopie la valeur de la colonne 11
       sheets(i).Cells(lig, 12).Resize(, 1).Copy Range("B1000").End(xlUp).Offset(1, 4) 'recopie la valeur de la colonne 12
       sheets(i).Cells(lig, 13).Resize(, 1).Copy Range("B1000").End(xlUp).Offset(1, 5) 'recopie la valeur de la colonne 13
       sheets(i).Cells(lig, 14).Resize(, 1).Copy Range("B1000").End(xlUp).Offset(1, 6) 'recopie la valeur de la colonne 14
       Range("B300").End(xlUp).Offset(1) = sheets(i).Name 'recopie le nom de l'onglet
     End If
   Next lig
 Next i

'Recupere la dernière cellule en colonne B
DerLigne = Cells(Rows.Count, "B").End(xlUp).Row
nomagence = sheets("PAGE DE GARDE").Range("E15")
'MsgBox (DerLigne)
For i = 4 To DerLigne
       Range("A" & i) = nomagence
       ' on ecris la formule =SI(ESTVIDE(B4);"";nom_Agence)
       'Range("A" & i).FormulaR1C1 = "=IF(ISBLANK(RC[1]),"""",nom_Agence)"
Next

'Appliquer une ecriture de 9 et une mise en forme des cellules
    Range("A4:H4").Select
    Range(Selection, Selection.End(xlDown)).Select
    'Taille police 9
    With Selection.Font
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
    End With
    'Appliquer une mise en forme des cellules
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
Rows("4:" & DerLigne).EntireRow.AutoFit
'definition de la zone d'impression
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & DerLigne

Application.ScreenUpdating = True

End Sub

Aujourd'hui ce code passe sur toute les feuilles du classeurs. le temps est assez long pour remplir la feuille "synthese".

Serait il possible de le faire uniquement passer sur les feuilles (PVC - Débit, PVC - Soudage, PVC - Assem. ferrures, PVC - Assem. Menuiserie, PVC - Vitrage-Expé, ALU - Débit, ALU - Assem. ferrures, ALU - Assem. Menuiserie, ALU - Vitrage) et peux t'on l'optimiser pour améliorer son exécution.

Je vous remercie de votre aide par avance.

15du.zip (395.82 Ko)
Le 05/11/2020 à 23:42

Bonjour,

Votre macro qui doit se déclencher à l'activation d'une feuille, il faut la mettre dans un module normal sous un nom de macro propre :

Sub AvecFeuilles(Feuille as worksheet) 'par exemple

Dim DerLigne As Integer

Application.Run ("Miseenformeconditionnellle") 'permet d'appeler une macro privée

with Feuille
    DerLigne = .Cells(.Rows.Count, 1).End(xlUp).Row 'Si tu veux la dernière cellule en colonne A
    .Range("I8:I" & DerLigne).FormatConditions.Delete 'efface la mise en forme conditionnelle de la colonne I
    For i = 8 To DerLigne
       .Range("F" & i).Formula = "=D" & i & "*" & "E" & i
       .Range("I" & i).Formula = "=F" & i & "*" & "H" & i
       .Range("O" & i).Formula = "=IF(J" & i & "="""",""OUI"",""NON"")" 'formule =SI(J8="";"OUI";"NON")
    Next
    .columns(15).Hidden = True
    .PageSetup.PrintArea = "$A$1:$N$" & DerLigne 'definition de la zone d'impression
    ActiveWindow.Zoom = 80 'definition du zoom de la feuille
    .Range("A8").Activate
end with

appName = "Document Unique"
appVersion = "1.01"
Application.StatusBar = appName & " (Version " & appVersion & ")"

End Sub

Puis, dans thisworkbook, vous pouvez l'appeler, c'est plus simple et mieux :

Private sub sorkbook_sheetactivate(byval Sh As Object)
'PVC - Débit, PVC - Soudage, PVC - Assem. ferrures, PVC - Assem. Menuiserie, PVC - Vitrage-Expé, ALU - Débit, ALU - Assem. ferrures, ALU - Assem. Menuiserie, ALU - Vitrage
if Sh.name <> "nomdelafeuillequinedoitpasdeclencher" then 'cadrer condition !!!
    Call AvecFeuilles(Sh)
end if
end sub

Pour savoir sur quelles feuilles l'exécuter, pourriez-vous me donner les feuilles qui ne sont pas concernées par cette macro ?

Cdlt,

Le 06/11/2020 à 09:06

Bonjour 3GB,

Merci pour ce retour. Pour les feuilles à exclure voici la liste : PAGE DE GARDE, METHODOLOGIE, COMMUN

J'avais dans mon message indiqué un autre code pour ma feuille "Synthese", le code est il optimisé ?

A te lire

Le 06/11/2020 à 10:43

Bonjour,

Alors avec ces feuilles à exclure, vous pouvez modifier la macro évènementielle :

Private sub sorkbook_sheetactivate(byval Sh As Object)
if Sh.name <> "PAGE DE GARDE" or Sh.name <> "METHODOLOGIE" or Sh.name <> "COMMUN" then
    Call AvecFeuilles(Sh)
end if
end sub

Non, votre seconde macro n'est pas optimisée . Mais elle est relativement longue et concerne en majeure partie de la mise en forme. Il faut éventuellement que vous supprimiez tous les arguments qui ne sont pas nécessaires pour la simplifier dans un premier temps.

Cdlt,

Le 06/11/2020 à 12:23

J'ai essayé le nouveau code, mais la macro évènementielle s'exécute sur toutes les feuilles même celles à exclure. Je ne comprends pas.

Le 06/11/2020 à 13:23

Et bien, je pense qu'il faut mettre le nom exact des feuilles à exclure dans la macro Private sub workbook_sheetactivate (petite coquille "s" à remplacer par "w").

Le 06/11/2020 à 13:51

J'avais vu cette petite coquille. Mais justement même après modification, cela ne fonctionne pas.

La procédure fonctionne quand il n'y qu'une feuille ?? 

Private Sub workbook_sheetactivate(ByVal sh As Object)
If sh.Name <> "PAGE DE GARDE" Then 'cadrer condition !!!
    Call AvecFeuilles(sh)
End If
End Sub
Le 06/11/2020 à 15:28

Essayez comme ceci :

Private sub sorkbook_sheetactivate(byval Sh As Object)
if Sh.name <> "PAGE DE GARDE" and Sh.name <> "METHODOLOGIE" and Sh.name <> "COMMUN" then
    Call AvecFeuilles(Sh)
end if
end sub

C'est l'opérateur qui n'était pas bon car forcément le nom d'une feuille ne peut avoir qu'une valeur et est différent des 2 autres... Désolé.

Le 09/11/2020 à 10:02

Effectivement maintenant cela fonctionne.

Encore un grand merci.

Rechercher des sujets similaires à "optimisation code vba"