Optimisation de macros

Le 10/10/2018 à 18:07

Bonjour à tous,

Je suis nouveau, et voilà deux jours que j'essaye de créer des macros.

J'ai crée un premier fichier Excel avec de suivre une progression de performances, avec une feuille par mois. Après des heures de recherches et d'essais, je suis parvenu à avoir exactement ce que je souhaite.

Fonctionnement de l'Excel :

  • On entre une valeur dans la cellule en J7 sur la feuille du mois
  • On valide en cliquant sur le symbole valider à droite
  • Le graphique se met à jour automatiquement
  • En appuyant sur le symbole supprimer, le dernier point est supprimé
  • Il est possible de masquer ou d'afficher les objectifs en cliquant sur les symboles correspondant

Il y a une feuille et un module par mois, ainsi qu'une feuille données où sont stockée les valeurs entrées en J7 dans chaque feuille ainsi que la date et les objectifs correspondants.

Voici le code d'un module (Janvier).

Sub Ajouter_Janvier()

    'Cacher les changements d'onglet pendant l'exécution
    Application.ScreenUpdating = False

    'Chercher la première ligne vide dans la colonne
    Dim Lig As Long
        Lig = 3
        Do While Not IsEmpty(Range("Données!C" & Lig))
        Lig = Lig + 1
        Loop       

    ligne = Lig
    ligne_précédente = Lig - 1
    ligne_précedente_2 = ligne - 2

    Sheets("Données").Activate

    variable_date = Date

    'Remplir le tableau de données
    Cells(ligne, 2).Value = Format(variable_date, "dd.mm.yy")

    Cells(ligne, 3).Value = Range("'Janvier'!J7").Value

    date_etiquette = Cells(ligne, 2).Text   

    Sheets(1).Activate

    'Avoir en étiquette la date à laquelle la perfomance a été enregistrée
    ActiveSheet.ChartObjects("Graphique 8").Activate

    ActiveChart.SeriesCollection(10).Points(ligne_précedente_2).DataLabel.Characters.Text = date_etiquette

    'Revenir comme un début
    Range("'Janvier'!J7").MergeArea.ClearContents

    Range("'Janvier'!J7").Select    

End Sub

Sub Supprimer_Janvier()

    'Chercher la première ligne vide dans la colonne
    Dim Lig As Long
        Lig = 3
        Do While Not IsEmpty(Range("Données!C" & Lig))
        Lig = Lig + 1
        Loop

    ligne = Lig
    ligne_précédente = Lig - 1

    Sheets("Données").Activate

    'Effacer la dernière date et la dernière performance dans le tableau
    Cells(ligne_précédente, 2).ClearContents
    Cells(ligne_précédente, 3).ClearContents

    'Revenir à l'onglet 1
    Sheets(1).Activate

End Sub

Sub Afficher_dates_Janvier()

    'Mettre les etiquettes en transparence 0%
    ActiveSheet.ChartObjects("Graphique 8").Activate
    ActiveChart.FullSeriesCollection(10).DataLabels.Select

    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorLight1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.25
        .Transparency = 0
        .Solid
    End With   

    Range("J7").Select

End Sub

Sub Masquer_dates_Janvier() 'MODIF

    'Mettre les etiquettes en transparence 100%
    ActiveSheet.ChartObjects("Graphique 8").Activate 'MODIF
    ActiveChart.FullSeriesCollection(10).DataLabels.Select

    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorLight1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.25
        .Transparency = 1
        .Solid
    End With

    Range("J7").Select

End Sub

Sub Masquer_classes_Janvier() 'MODIF

    'Mettre les droites en transparence 100%
    ActiveSheet.ChartObjects("Graphique 8").Activate 'MODIF
    ActiveChart.FullSeriesCollection(9).Select

    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(8).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(7).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(6).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(5).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(4).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(3).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(2).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Line
        .Transparency = 1
    End With

    Range("J7").Select

End Sub

Sub Afficher_classes_Janvier() 'MODIF

    'Mettre les droites en transparence 0%
    ActiveSheet.ChartObjects("Graphique 8").Activate 'MODIF
    ActiveChart.FullSeriesCollection(9).Select

    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(8).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(7).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(6).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(5).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(4).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(3).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(2).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Line
        .Transparency = 0.5
    End With

    Range("J7").Select

End Sub

Les macros sont relativement longues à s'exécuter. Ce sont mes premières macros, j'ai bidouillé comme j'ai pu pour arriver au résultat que je souhaitais, mais je pense que beaucoup de choses ne vont pas, sont mal organisées et auraient pu être faite plus proprement.

J'aimerais partir sur de bonnes bases pour mes prochaines macros. Pourriez-vous me dire ce qu'il y a à améliorer ? (certainement beaucoup de choses )

En vous remerciant par avance

16performances2.xlsm (66.68 Ko)
Le 10/10/2018 à 21:02

Bonjour et bienvenue sur le forum

Un essai à tester.

Les mêmes macros doivent pouvoir fonctionner sur toutes les feuilles de mois.

Cela te convient-il ?

Bye !

7performances2-v1.xlsm (58.15 Ko)
Le 11/10/2018 à 12:02

Tout d'abord merci pour ton aide.

J'ai testé ton fichier, j'ai un soucis au niveau de ActiveSheet.ChartObjects("Graphique " & numGraph).Activate : "L'élément portant ce nom est introuvable."

J'ai cherché d'où pouvait venir cette erreur, mais je n'ai pas trouvé. Je suppose que ça vient de la macro Selection_du_Graphe.

Il y a quelque chose que je ne comprends pas dans cette macro.

Sub Selection_du_Graphe()

    For i = 1 To 2 ' si on a les feuilles des 12 mois on mettra : for i = 1 to 12
        nomm = Choose(2, "Janvier", "Fevrier") ' on pourra compléter les mois ; ici, on en a 2
        numGraph = Choose(2, 8, 7)      '2 pour le nombre de feuilles, 8 et 7 pour le numéro de leur graphe
        If nomm = ActiveSheet.Name Then
            ActiveSheet.ChartObjects("Graphique " & numGraph).Activate
            ActiveChart.FullSeriesCollection(10).DataLabels.Select
            Exit For    'on sort de la boucle lorsque le numéro de graphe a été trouvé
                        'et qu'on l'a sélectionné
        End If
    Next i
End Sub

D'après ce que je comprends, ici numGraph prendra toujours la valeur 7 et nomm Fevrier. A quel moment est utilisé le i de la boucle for ?

EDIT : Ça fonctionne bien en utilisant :

        nomm = Choose(i, "Janvier", "Fevrier") ' on pourra compléter les mois ; ici, on en a 2
        numGraph = Choose(i, 8, 7)      '2 pour le nombre de feuilles, 8 et 7 pour le numéro de leur graphe

Mais j'ai à présent un soucis au niveau du fonctionnement.

Les coordonnées des points sont stockés dans l'onglet données. Les valeurs de la performance de Janvier sont stockées en colonne C, celles de Fevrier en colonne O.

Dans le code, on utilise :

Range("C" & Lig)

En utilisant la même macro pour tous les mois c'est toujours une ligne de la colonne C qui est remplie ou supprimée, donc toujours dans Janvier même sur la feuille Fevrier. Comment faire varier la colonne en fonction de la feuille (Feuille 1 : Range("C" & Lig), Feuille 2 : Range("O" & Lig)...) ?

Le 11/10/2018 à 13:07
Perajie a écrit :

Ça fonctionne bien en utilisant :...

Tu as raison et tu as fait la bonne correction.

Dans le code, on utilise :

Range("C" & Lig)

Il faut donc mettre dans une variable le numéro de la bonne colonne, selon la feuille de départ.

Voir version 2.

Bye !

10performances2-v2.xlsm (59.55 Ko)
Le 12/10/2018 à 17:39

Super ça fonctionne très bien maintenant avec un seul code pour tous les mois.

J'ai simplement du mettre ces variables en prenant exemple sur la variable Col que tu as crée.

    
    col_date = fd.Rows("1:1").Find(fa.Name).Column + 1
    col_perf = fd.Rows("1:1").Find(fa.Name).Column + 2

    fd.Cells(ligne, col_date).Value = Format(variable_date, "dd.mm.yy")
    fd.Cells(ligne, col_perf).Value = fa.Range("J7").Value

Merci beaucoup !

Rechercher des sujets similaires à "optimisation macros"