Modifier la plage de l'axe des abscisses d'un graphique Excel par VBA

Le 22/02/2023 à 18:33

Bonjour,

Bon cette fois sujet plus critique ^^'.

L'objectif du code ci-dessous est de:

- Sélectionner dans un classeur toutes les feuilles ayant 1 graphe (feuille incluant dans leur nom le mot "Graph")

- Sélectionner le graph de chacune de ces feuilles (1 seul graphe par feuille)

- Modifier la plage des abscisses du graphe de la manière suivante:

la plage est définie selon un userform4 avec 2 ComboBox : ComboBox1 = valeur de départ / ComboBox2 = valeur de fin

Les valeurs des Combobox1 et 2 sont récupérées dans la feuille "Tableau de saisie" colonne A.

Lorsque j'exécute la macro, je n'ai pas d'erreur, mais pas non plus de graphe "filtré" selon la plage définie par les ComboBox1 et 2.

Merci pour votre aide !

Cordialement !

Private Sub CommandButton1_Click()
ActiveWorkbook.Unprotect Password:="MDP"

Dim ws As Worksheet
Dim gr As ChartObject

For Each ws In ThisWorkbook.Worksheets
    If InStr(1, ws.Name, "Graph") > 0 Then
        For Each gr In ws.ChartObjects
           gr.Select
           gr.chart.SeriesCollection(1).XValues = ThisWorkbook.Sheets("Tableau de saisie").Union(Range("A25:A224").Find(UserForm4.ComboBox1), Range("A25:A224").Find(UserForm4.ComboBox2))
                Exit For
        Next gr
    End If
Next ws

Unload Me
ActiveWorkbook.Protect Password:="MDP"
End Sub
Le 23/02/2023 à 18:51

Bonsoir,

J'ai complètement repris le code comme suit.

Le problème est que la déclaration de la variable chartSeries par un objet de type "Series" ne semble pas fonctionner chez moi, lorsque j'écris As Series, le S majuscule devient s minuscule, ce qui me semble ne pas être bon ! Pourtant j'ai bien la référence "Microsoft Excel 16.0 Object Library" cochée.

Le truc fou est que j'ai essayé sur un autre classeur Excel et le As Series apparaît bien avec un S majuscule !

Pour rappel mon code se trouve dans un Userform, mais il ne devrait pas y avoir de problème normalement.

Avec ce code ce sont les lignes de code :

chartSeries.XValues = wsCalcul.Range(startRangeA.Address, endRangeA.Address)
chartSeries.Values = wsCalcul.Range(startRangeB.Address, endRangeB.Address)

Qui retournent une erreur de type : Erreur d'exécution '-2147467259 (80004005)

(La méthode 'Xvalues' de l'objet 'Series' a échoué) --> là on parle d'Objet 'Series'

J'ai fait des vérif avec DebugPrint, pas de soucis (apparemment) au-dessus mais je ne suis pas expert donc bon !

Merci d'avance pour votre aide !

Private Sub CommandButton1_Click()
    Application.EnableEvents = False
    ActiveWorkbook.Unprotect Password:="CPV"

    Dim wsGraphique As Chart
    Dim wsCalcul As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim startRangeA As Range, endRangeA As Range
    Dim startRangeB As Range, endRangeB As Range
    Dim chartSeries As series
    Dim seriesCollection As seriesCollection

    ' Parcourir toutes les feuilles de graphique
    For j = 2 To ThisWorkbook.Charts.Count
        ' Récupérer la feuille Graphique correspondante
        Set wsGraphique = ThisWorkbook.Charts(j)

        ' Parcourir toutes les feuilles de calcul
        For i = 1 To ThisWorkbook.Worksheets.Count
            ' Récupérer la feuille Calcul Colonne correspondante
            Set wsCalcul = ThisWorkbook.Worksheets(i)

            ' Déterminer la plage de données
            Set startRangeA = wsCalcul.Range("A2:A201").Find(ComboBox1)
            Set endRangeA = wsCalcul.Range("A2:A201").Find(ComboBox2)
            If Not startRangeA Is Nothing Then
                Set startRangeB = startRangeA.Offset(0, 1)
                Set endRangeB = endRangeA.Offset(0, 1)
            End If

            ' Modifier la plage de données du graphique sur la feuille Graphique
            Set seriesCollection = wsGraphique.seriesCollection
            For Each chartSeries In seriesCollection
                Set chartSeries = wsGraphique.seriesCollection(1)
chartSeries.XValues = wsCalcul.Range(startRangeA.Address, endRangeA.Address)
chartSeries.Values = wsCalcul.Range(startRangeB.Address, endRangeB.Address)
            Next chartSeries
        Next i
    Next j

    Unload Me
    ActiveWorkbook.Protect Password:="CPV"
    Application.EnableEvents = True
End Sub
Le 24/02/2023 à 09:17

Bonjour,

Ok j'ai eu une mise à jour d'Excel et l'objet est réapparu comme par magie !

Je continue à travailler le code et reviens vers vous si problème.

Cordialement !

Le 24/02/2023 à 11:34

bonjour Arkadia73,

   Set seriesCollection = wsGraphique.seriesCollection

Nommer un varaible avec un nom qui est aussi un object en VBA, cela est demander des problèmes. Il faut ajouter/modifier quelque, par exemple "Set seriesCollection1 = wsGraphique.seriesCollection"

Puis, je pense qu'on doit vérifier sie StartRangeA et EndRangeA existent, mais je ne connais pas votre fichier, donc ???

               Set startRangeA = wsCalcul.Range("A2:A201").Find("cc")
               Set endRangeA = wsCalcul.Range("A2:A201").Find(ComboBox2)
               If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
                    With wsGraphique.seriesCollection(1)
                         .XValues = wsCalcul.Range(startRangeA.Address, endRangeA.Address)
                         .Values = wsCalcul.Range(startRangeA.Address, endRangeA.Address).Offset(, 1)
                    End With
               End If
Le 27/02/2023 à 12:27

Bonjour BsAlv,

Je viens juste de voir votre message, j'ai retravaillé le code depuis. Je vous ai églement joint un fichier type.

Les objectifs :

Sur la feuille 'Saisie' j'ai les données.

J'ai ensuite des couples de feuilles nommés Graph Colonne 'lettre' (feuille graphique) / Calcul Colonne 'lettre' (feuille calcul) j'ai mis dans le fichier les couples X et Y mais dans mon fichier original je vais jusqu'à BN.

Les données de la feuille Calcul Colonne 'lettre' proviennent de la feuille 'Saisie' entre autre:

Les data 'Numéro' et 'Donnée'. Les autres colonnes sont des calculs (j'ai volontairement copié/collé valeur, car le calcul n'a pas d'importance en soi dans le code).

Le graphe est entièrement construit à partir de la feuille Calcul Colonne 'lettre'.

L'objectif final est donc de :

1 - Cliquer sur le bouton OK de l'onglet 'Saisie'

2 - Indiquer la période à afficher (les Combobox1 et 2 recherchent le 'numéro' dans la colonne A de l'onglet 'Saisie')

3 - Modifier les plages de tous les graphes pour faire apparaître l'ensemble des données sur la période souhaitée.

Voici les problèmes que je rencontre actuellement:

Le code "fonctionne" pour le graphe X, en gros il affiche bien ce que je veux, toutes les séries du graphe proviennent bien de la bonne feuille de Calcul Colonne X.

Mais j'ai une erreur d'exécution '1004' sur la ligne de code :

 wsGraphique.SeriesCollection(1).Values = wsCalcul.Range(startRangeB, endRangeB)

Je pense que la boucle sur le graphe Y ne marche pas.

Les points d'attention:

Etant donné que je n'ai rien compris pour l'indice d'incrémentation des feuilles et que le fichier a subit pas mal de suppression/addition/modification de feuilles, j'ai volontairement choisi d'aller réconcilier les feuilles de calcul et graphique ayant la même lettre en les nommant directement (le nom ne va pas changer pour la version finale).

Les plus ++:

Pour la suite j'aimerais soit faire fonctionner le code pour tous les graphes (mais ça prend beaucoup de temps vu qu'il vérifie chaque cellule) ou que je puisse choisir via le nom du graphe.

A ce jour j'ai une mise à jour complète.

Merci d'avance pour votre retour !

9test-arkadia.xlsm (88.14 Ko)

Le code est ici:

Private Sub UpdateGraph(ByVal graphNames As Variant)
Application.EnableEvents = False
    ActiveWorkbook.Unprotect Password:="MDP"

    Dim wsGraphique As Chart
    Dim wsCalcul As Worksheet
    Dim startRangeA As Range
    Dim endRangeA As Range
    Dim startRangeB As Range
    Dim endRangeB As Range
    Dim startRangeC As Range
    Dim endRangeC As Range
    Dim startRangeD As Range
    Dim endRangeD As Range
    Dim startRangeE As Range
    Dim endRangeE As Range
    Dim startRangeF As Range
    Dim endRangeF As Range
    Dim startRangeG As Range
    Dim endRangeG As Range
    Dim startRangeH As Range
    Dim endRangeH As Range
    Dim startRangeI As Range
    Dim endRangeI As Range
    Dim startRangeJ As Range
    Dim endRangeJ As Range
    Dim startRangeK As Range
    Dim endRangeK As Range
    Dim startRangeL As Range
    Dim endRangeL As Range
    Dim startRangeM As Range
    Dim endRangeM As Range
    Dim startRangeN As Range
    Dim endRangeN As Range
    Dim rng As Range
    Dim chartseries As Series
    Dim lastRow As Long
    Dim cell As Range
    Dim graphName As Variant
    Dim calculName As Variant

    graphNames = Array("Graph Colonne X", "Graph Colonne Y", "Graph Colonne Z", "Graph Colonne AA", "Graph Colonne AB", "Graph Colonne AC", "Graph Colonne AD", "Graph Colonne AE" _
    , "Graph Colonne AF", "Graph Colonne AG", "Graph Colonne AH", "Graph Colonne AI", "Graph Colonne AJ", "Graph Colonne AK", "Graph Colonne AL", "Graph Colonne AM" _
    , "Graph Colonne AN", "Graph Colonne AO", "Graph Colonne AP", "Graph Colonne AQ", "Graph Colonne AR", "Graph Colonne AS", "Graph Colonne AT", "Graph Colonne AU" _
    , "Graph Colonne AV", "Graph Colonne AW", "Graph Colonne AX", "Graph Colonne AY", "Graph Colonne AZ", "Graph Colonne BA", "Graph Colonne BB", "Graph Colonne BC" _
    , "Graph Colonne BD", "Graph Colonne BE", "Graph Colonne BF", "Graph Colonne BG", "Graph Colonne BH", "Graph Colonne BI", "Graph Colonne BJ", "Graph Colonne BK" _
    , "Graph Colonne BL", "Graph Colonne BM", "Graph Colonne BN")

    Dim calculNames As Variant
    calculNames = Array("Calcul Colonne X", "Calcul Colonne Y", "Calcul Colonne Z", "Calcul Colonne AA", "Calcul Colonne AB", "Calcul Colonne AC", "Calcul Colonne AD", "Calcul Colonne AE" _
    , "Calcul Colonne AF", "Calcul Colonne AG", "Calcul Colonne AH", "Calcul Colonne AI", "Calcul Colonne AJ", "Calcul Colonne AK", "Calcul Colonne AL", "Calcul Colonne AM" _
    , "Calcul Colonne AN", "Calcul Colonne AO", "Calcul Colonne AP", "Calcul Colonne AQ", "Calcul Colonne AR", "Calcul Colonne AS", "Calcul Colonne AT", "Calcul Colonne AU" _
    , "Calcul Colonne AV", "Calcul Colonne AW", "Calcul Colonne AX", "Calcul Colonne AY", "Calcul Colonne AZ", "Calcul Colonne BA", "Calcul Colonne BB", "Calcul Colonne BC" _
    , "Calcul Colonne BD", "Calcul Colonne BE", "Calcul Colonne BF", "Calcul Colonne BG", "Calcul Colonne BH", "Calcul Colonne BI", "Calcul Colonne BJ", "Calcul Colonne BK" _
    , "Calcul Colonne BL", "Calcul Colonne BM", "Calcul Colonne BN")

    ' Enlever la protection des feuilles de calcul et de graphique
    For Each wsCalcul In ThisWorkbook.Worksheets
        wsCalcul.Unprotect Password:="MDP"
    Next wsCalcul

    For Each wsGraphique In ThisWorkbook.Charts
        wsGraphique.Unprotect Password:="MDP"
    Next wsGraphique

 ' Récupérer la feuille Graphique correspondante
    For Each graphName In graphNames
    Set wsGraphique = ThisWorkbook.Charts(graphName)

    ' Récupérer la feuille Calcul correspondante pour ce graphique
    For Each calculName In calculNames
    Set wsCalcul = ThisWorkbook.Worksheets(calculName)

    ' Chercher la première correspondance dans la colonne A
    For Each cell In wsCalcul.Range("A2:A" & wsCalcul.Cells(wsCalcul.Rows.Count, "A").End(xlUp).Row)
        If cell.Value = ComboBox1.Value Then
            Set startRangeA = cell
        End If
        If cell.Value = ComboBox2.Value Then
            Set endRangeA = cell
        End If
    Next cell

 ' Si la première correspondance a été trouvée, chercher la correspondance dans la colonne B
    If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
        For Each cell In wsCalcul.Range("B2:B" & wsCalcul.Cells(wsCalcul.Rows.Count, "B").End(xlUp).Row)
            If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
                If startRangeB Is Nothing Then
                        Set startRangeB = cell
                        End If
                        Set endRangeB = cell
                    End If
                Next cell
    End If

     If Not startRangeB Is Nothing And Not endRangeB Is Nothing Then
        For Each cell In wsCalcul.Range("C2:C" & wsCalcul.Cells(wsCalcul.Rows.Count, "C").End(xlUp).Row)
            If cell.Row >= startRangeB.Row And cell.Row <= endRangeB.Row Then
                If startRangeC Is Nothing Then
                            Set startRangeC = cell
                        End If
                        Set endRangeC = cell
                    End If
                Next cell
    End If
    If Not startRangeC Is Nothing And Not endRangeC Is Nothing Then
        For Each cell In wsCalcul.Range("D2:D" & wsCalcul.Cells(wsCalcul.Rows.Count, "D").End(xlUp).Row)
            If cell.Row >= startRangeC.Row And cell.Row <= endRangeC.Row Then
                     If startRangeD Is Nothing Then
                            Set startRangeD = cell
                        End If
                        Set endRangeD = cell
                    End If
                Next cell
    End If
      If Not startRangeD Is Nothing And Not endRangeD Is Nothing Then
        For Each cell In wsCalcul.Range("E2:E" & wsCalcul.Cells(wsCalcul.Rows.Count, "E").End(xlUp).Row)
            If cell.Row >= startRangeD.Row And cell.Row <= endRangeD.Row Then
                   If startRangeE Is Nothing Then
                            Set startRangeE = cell
                        End If
                        Set endRangeE = cell
                    End If
                Next cell
    End If
     If Not startRangeE Is Nothing And Not endRangeE Is Nothing Then
        For Each cell In wsCalcul.Range("F2:F" & wsCalcul.Cells(wsCalcul.Rows.Count, "F").End(xlUp).Row)
            If cell.Row >= startRangeE.Row And cell.Row <= endRangeE.Row Then
                   If startRangeF Is Nothing Then
                            Set startRangeF = cell
                        End If
                        Set endRangeF = cell
                    End If
                Next cell
    End If
      If Not startRangeF Is Nothing And Not endRangeF Is Nothing Then
        For Each cell In wsCalcul.Range("G2:G" & wsCalcul.Cells(wsCalcul.Rows.Count, "G").End(xlUp).Row)
            If cell.Row >= startRangeF.Row And cell.Row <= endRangeF.Row Then
                   If startRangeG Is Nothing Then
                            Set startRangeG = cell
                        End If
                        Set endRangeG = cell
                    End If
                Next cell
    End If
      If Not startRangeG Is Nothing And Not endRangeG Is Nothing Then
        For Each cell In wsCalcul.Range("H2:H" & wsCalcul.Cells(wsCalcul.Rows.Count, "H").End(xlUp).Row)
            If cell.Row >= startRangeG.Row And cell.Row <= endRangeG.Row Then
                   If startRangeH Is Nothing Then
                            Set startRangeH = cell
                        End If
                        Set endRangeH = cell
                    End If
                Next cell
    End If
     If Not startRangeH Is Nothing And Not endRangeH Is Nothing Then
        For Each cell In wsCalcul.Range("I2:I" & wsCalcul.Cells(wsCalcul.Rows.Count, "I").End(xlUp).Row)
            If cell.Row >= startRangeH.Row And cell.Row <= endRangeH.Row Then
                   If startRangeI Is Nothing Then
                            Set startRangeI = cell
                        End If
                        Set endRangeI = cell
                    End If
                Next cell
    End If
       If Not startRangeI Is Nothing And Not endRangeI Is Nothing Then
        For Each cell In wsCalcul.Range("J2:J" & wsCalcul.Cells(wsCalcul.Rows.Count, "J").End(xlUp).Row)
            If cell.Row >= startRangeI.Row And cell.Row <= endRangeI.Row Then
                   If startRangeJ Is Nothing Then
                            Set startRangeJ = cell
                        End If
                        Set endRangeJ = cell
                    End If
                Next cell
    End If
        If Not startRangeJ Is Nothing And Not endRangeJ Is Nothing Then
        For Each cell In wsCalcul.Range("K2:K" & wsCalcul.Cells(wsCalcul.Rows.Count, "K").End(xlUp).Row)
            If cell.Row >= startRangeJ.Row And cell.Row <= endRangeJ.Row Then
                   If startRangeK Is Nothing Then
                            Set startRangeK = cell
                        End If
                        Set endRangeK = cell
                    End If
                Next cell
    End If
      If Not startRangeK Is Nothing And Not endRangeK Is Nothing Then
        For Each cell In wsCalcul.Range("L2:L" & wsCalcul.Cells(wsCalcul.Rows.Count, "L").End(xlUp).Row)
            If cell.Row >= startRangeK.Row And cell.Row <= endRangeK.Row Then
                   If startRangeL Is Nothing Then
                            Set startRangeL = cell
                        End If
                        Set endRangeL = cell
                    End If
                Next cell
    End If
    If Not startRangeL Is Nothing And Not endRangeL Is Nothing Then
        For Each cell In wsCalcul.Range("M2:M" & wsCalcul.Cells(wsCalcul.Rows.Count, "M").End(xlUp).Row)
            If cell.Row >= startRangeL.Row And cell.Row <= endRangeL.Row Then
                   If startRangeM Is Nothing Then
                            Set startRangeM = cell
                        End If
                        Set endRangeM = cell
                    End If
                Next cell
    End If
    If Not startRangeM Is Nothing And Not endRangeM Is Nothing Then
        For Each cell In wsCalcul.Range("N2:N" & wsCalcul.Cells(wsCalcul.Rows.Count, "N").End(xlUp).Row)
            If cell.Row >= startRangeM.Row And cell.Row <= endRangeM.Row Then
                   If startRangeN Is Nothing Then
                            Set startRangeN = cell
                        End If
                        Set endRangeN = cell
                    End If
                Next cell
    End If

    ' Si les plages de données ont été trouvées, modifier la plage de données du graphique sur la feuille Graphique
    If Not startRangeA Is Nothing And Not endRangeA Is Nothing And _
    Not startRangeB Is Nothing And Not endRangeB Is Nothing And _
    Not startRangeC Is Nothing And Not endRangeC Is Nothing And _
    Not startRangeD Is Nothing And Not endRangeD Is Nothing And _
    Not startRangeE Is Nothing And Not endRangeE Is Nothing And _
    Not startRangeF Is Nothing And Not endRangeF Is Nothing And _
    Not startRangeG Is Nothing And Not endRangeG Is Nothing And _
    Not startRangeH Is Nothing And Not endRangeH Is Nothing And _
    Not startRangeI Is Nothing And Not endRangeI Is Nothing And _
    Not startRangeJ Is Nothing And Not endRangeJ Is Nothing And _
    Not startRangeK Is Nothing And Not endRangeK Is Nothing And _
    Not startRangeL Is Nothing And Not endRangeL Is Nothing And _
    Not startRangeM Is Nothing And Not endRangeM Is Nothing And _
    Not startRangeN Is Nothing And Not endRangeN Is Nothing Then

        wsGraphique.SeriesCollection(1).Values = wsCalcul.Range(startRangeB, endRangeB)
        wsGraphique.SeriesCollection(2).Values = wsCalcul.Range(startRangeC, endRangeC)
        wsGraphique.SeriesCollection(3).Values = wsCalcul.Range(startRangeD, endRangeD)
        wsGraphique.SeriesCollection(4).Values = wsCalcul.Range(startRangeE, endRangeE)
        wsGraphique.SeriesCollection(5).Values = wsCalcul.Range(startRangeF, endRangeF)
        wsGraphique.SeriesCollection(6).Values = wsCalcul.Range(startRangeG, endRangeG)
        wsGraphique.SeriesCollection(7).Values = wsCalcul.Range(startRangeH, endRangeH)
        wsGraphique.SeriesCollection(8).Values = wsCalcul.Range(startRangeI, endRangeI)
        wsGraphique.SeriesCollection(9).Values = wsCalcul.Range(startRangeJ, endRangeJ)
        wsGraphique.SeriesCollection(10).Values = wsCalcul.Range(startRangeK, endRangeK)
        wsGraphique.SeriesCollection(11).Values = wsCalcul.Range(startRangeL, endRangeL)
        wsGraphique.SeriesCollection(12).Values = wsCalcul.Range(startRangeM, endRangeM)
        wsGraphique.SeriesCollection(13).Values = wsCalcul.Range(startRangeN, endRangeN)
                        End If

                Next calculName
    Next graphName

    ' Réappliquer la protection des feuilles de calcul et de graphique
    For Each wsCalcul In ThisWorkbook.Worksheets
        wsCalcul.Protect Password:="MDP"
    Next wsCalcul

    For Each wsGraphique In ThisWorkbook.Charts
        wsGraphique.Protect Password:="MDP"
    Next wsGraphique

    Application.EnableEvents = True
End Sub
Le 27/02/2023 à 14:06
Le 27/02/2023 à 15:42

bonjour,

un essai

14test-arkadia.xlsm (87.18 Ko)
Le 27/02/2023 à 17:19

Alors là chapeau bas ! Le code est beaaaaaaaucoup plus optimisé (même en temps d'exé). Merci beaucoup !

J'avais oublié de parler de la protection, j'ai donc rajouté ces deux lignes de code pour le faire, je ne sais pas si on peut optimiser, dans l'absolu je déprotège et protège feuille par feuille. 

Sub Grafiek(Optional b)
     'avec le userform et comboboxes
     If 1 <= iDébut And iDébut <= iFin Then

          For Each Sh In ThisWorkbook.Sheets     'boucle toutes les feuilles
          Sh.Unprotect Password:="MDP"
               If Sh.Name Like "Graph Colonne *" Then     'une feuille nommée Graph Colonne 'lettre'
                    On Error Resume Next
                    Set Sh1 = Nothing
                    Set Sh1 = Sheets(Replace(Sh.Name, "Graph", "Calcul"))
                    On Error GoTo 0
                    If Not Sh1 Is Nothing Then
                         With Sh
                              For i = 1 To .FullSeriesCollection.Count     'boucle tous les séries
                                   With .FullSeriesCollection(i)     'cette série
                                        sp = Split(.Formula, ",")     'diviser la formule

                                        spx = Split(sp(1), "!")     'la partie pour l'axe X
                                        Set c = Sh1.Range(spx(1))     'plage maintenant
                                        Set cx = c.Offset(1 - c.Row + iDébut).Resize(iFin - iDébut + 1)     'nouvelle plage
                                        sp(1) = spx(0) & "!" & cx.Address     'adapté dans la formule

                                        spy = Split(sp(2), "!")     'la partie pour l'axe Y
                                        Set c = Sh1.Range(spy(1))     'plage maintenant
                                        Set cy = cx.Offset(, c.Column - cx.Column)     'nouvelle plage
                                        sp(2) = spy(0) & "!" & cy.Address     'adapté dans la formule

                                        .Formula = Join(sp, ",")     'modifier la formule de cette série
                                   End With
                              Next
                         End With
                    End If
               End If
          Sh.Protect Password:="MDP"
          Next
     Else
          MsgBox "erreur avec votre plage !!!", vbCritical
     End If

End Sub
Le 27/02/2023 à 18:35

re,

peut-être encore déplacer ce "unprotect", dans les cas nécessaires ...

image

uet-etre

Le 28/02/2023 à 11:02

Bonjour,

Merci pour votre retour !

Si j'ai bien compris le code, il ne se lance pas s'il ne trouve pas le couple feuille Graphique / Calcul ? Dans mon template, ceci est impossible puisque chaque Graphe à sa feuille de Calcul de X à BN, en revanche une des conditions qui permettrait de ne pas lancer le code est si la colonne B de la feuille de Calcul Colonne * ne contient pas de données = feuille non utilisée.

Bon sinon j'ai un souci plus gros que je ne comprends pas, sur mon fichier de travail (hors fichier test qui fonctionne très bien), lorsque je lance une deuxième fois le code, j'ai un décalage des références des séries de chaque Graphe.

Ce décalage est plus ou moins important en fonction de la sélection dans les Combobox, par exemple j'ai sélectionné la première et la seconde valeur = 2 points dans le Graphe.

Dans le Graphe X j'ai les valeurs de la feuille de Calcul AA (axe x et y) sur 5 séries et sur les deux autres (j'ai axe y sur AA et axe x sur AB).

Tous les autres codes de mon classeur sont liés à la première feuille "Saisie" et n'interfère jamais avec les graphes ou les Combobox.

Je peux préparer un fichier type bis, car celui-ci est confidentiel.

Merci d'avance pour votre aide !

Cordialement !

Le 28/02/2023 à 12:07

l'entête de vos données, c'est bien la ligne 1 et la première ligne avec des données la ligne 2 ?

Le 10/03/2023 à 13:41

Bonjour à tous !

J'ai repris le code avec l'aide de BsAlv merci !

Le code ci-dessous ne fonctionne que pour le premier graphe.

Lorsque je relance la boucle j, étrangement la combobox1, représentée par "startRangeA" est reconnue mais pas la combobox2 représentée par "endRangeA" (j'ai mis des msgbox pour parcourir le code).

Les 2 combobox 1 et 2 de la boucle j = 1 (premier graph) sortent bien

et à j = 2, seule la première est reconnue, ce qui est bizarre vu que la combobox2 ne change pas tant que le userform n'est pas modifié.

Si besoin d'un fichier test, je dois en formater un car celui de travail est confidentiel.

Merci d'avance pour votre aide !

Module

Public Sub UpdateGraph()

' Désactiver les événements pour accélérer l'exécution
Application.EnableEvents = False
Application.ScreenUpdating = False

ActiveWorkbook.Unprotect Password:="CPV"

    Dim wsGraphique As Chart
    Dim wsCalcul As Worksheet
    Dim startRangeA As Range
    Dim endRangeA As Range
    Dim startRangeB As Range
    Dim endRangeB As Range
    Dim startRangeC As Range
    Dim endRangeC As Range
    Dim startRangeD As Range
    Dim endRangeD As Range
    Dim startRangeE As Range
    Dim endRangeE As Range
    Dim startRangeF As Range
    Dim endRangeF As Range
    Dim startRangeG As Range
    Dim endRangeG As Range
    Dim startRangeH As Range
    Dim endRangeH As Range
    Dim startRangeI As Range
    Dim endRangeI As Range
    Dim startRangeJ As Range
    Dim endRangeJ As Range
    Dim startRangeK As Range
    Dim endRangeK As Range
    Dim startRangeL As Range
    Dim endRangeL As Range
    Dim startRangeM As Range
    Dim endRangeM As Range
    Dim startRangeN As Range
    Dim endRangeN As Range
    Dim j As Integer
    Dim dataRange As Range

For j = 1 To ThisWorkbook.Charts.Count
    Set wsGraphique = ThisWorkbook.Charts(j)
    wsGraphique.Unprotect Password:="CPV"

    Set wsCalcul = ThisWorkbook.Worksheets(j + 2)
    wsCalcul.Unprotect Password:="CPV"

    wsGraphique.Unprotect Password:="CPV"
    wsCalcul.Unprotect Password:="CPV"

    ' Chercher la première correspondance dans la colonne A
For Each cell In wsCalcul.Range("A2:A201")
    If cell.Value = UserForm4.ComboBox1 Then
        Set startRangeA = cell
    MsgBox (startRangeA)
    End If
    If cell.Value = UserForm4.ComboBox2 Then
        Set endRangeA = cell
     MsgBox (endRangeA)
    End If
    If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
        Exit For ' Sort de la boucle si les deux ranges ont été définis
    End If
Next cell

' Si la première correspondance a été trouvée, chercher la correspondance dans la colonne B
If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeB Is Nothing Then
                Set startRangeB = cell.Offset(0, 1)
            End If
                Set endRangeB = cell.Offset(0, 1)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeC Is Nothing Then
                Set startRangeC = cell.Offset(0, 2)
            End If
            Set endRangeC = cell.Offset(0, 2)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeD Is Nothing Then
                Set startRangeD = cell.Offset(0, 3)
            End If
            Set endRangeD = cell.Offset(0, 3)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeE Is Nothing Then
                Set startRangeE = cell.Offset(0, 4)
            End If
            Set endRangeE = cell.Offset(0, 4)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeF Is Nothing Then
                Set startRangeF = cell.Offset(0, 5)
            End If
            Set endRangeF = cell.Offset(0, 5)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeG Is Nothing Then
                Set startRangeG = cell.Offset(0, 6)
            End If
            Set endRangeG = cell.Offset(0, 6)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeH Is Nothing Then
                Set startRangeH = cell.Offset(0, 7)
            End If
            Set endRangeH = cell.Offset(0, 7)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeI Is Nothing Then
                Set startRangeI = cell.Offset(0, 8)
            End If
            Set endRangeI = cell.Offset(0, 8)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeJ Is Nothing Then
                Set startRangeJ = cell.Offset(0, 9)
            End If
            Set endRangeJ = cell.Offset(0, 9)
        End If
    Next cell
End If

 If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeK Is Nothing Then
                Set startRangeK = cell.Offset(0, 10)
            End If
            Set endRangeK = cell.Offset(0, 10)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeL Is Nothing Then
                Set startRangeL = cell.Offset(0, 11)
            End If
            Set endRangeL = cell.Offset(0, 11)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeM Is Nothing Then
                Set startRangeM = cell.Offset(0, 12)
            End If
            Set endRangeM = cell.Offset(0, 12)
        End If
    Next cell
End If

If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row >= startRangeA.Row And cell.Row <= endRangeA.Row Then
            If startRangeN Is Nothing Then
                Set startRangeN = cell.Offset(0, 13)
            End If
            Set endRangeN = cell.Offset(0, 13)
        End If
    Next cell
End If

        wsGraphique.Unprotect Password:="CPV"
        wsGraphique.SeriesCollection(1).Values = wsCalcul.Range(startRangeB, endRangeB).Resize
        wsGraphique.SeriesCollection(1).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(2).Values = wsCalcul.Range(startRangeC, endRangeC).Resize
        wsGraphique.SeriesCollection(2).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(3).Values = wsCalcul.Range(startRangeD, endRangeD).Resize
        wsGraphique.SeriesCollection(3).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(4).Values = wsCalcul.Range(startRangeE, endRangeE).Resize
        wsGraphique.SeriesCollection(4).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(5).Values = wsCalcul.Range(startRangeF, endRangeF).Resize
        wsGraphique.SeriesCollection(5).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(6).Values = wsCalcul.Range(startRangeG, endRangeG).Resize
        wsGraphique.SeriesCollection(6).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(7).Values = wsCalcul.Range(startRangeH, endRangeH).Resize
        wsGraphique.SeriesCollection(7).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(8).Values = wsCalcul.Range(startRangeI, endRangeI).Resize
        wsGraphique.SeriesCollection(8).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(9).Values = wsCalcul.Range(startRangeJ, endRangeJ).Resize
        wsGraphique.SeriesCollection(9).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(10).Values = wsCalcul.Range(startRangeK, endRangeK).Resize
        wsGraphique.SeriesCollection(10).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(11).Values = wsCalcul.Range(startRangeL, endRangeL).Resize
        wsGraphique.SeriesCollection(11).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(12).Values = wsCalcul.Range(startRangeM, endRangeM).Resize
        wsGraphique.SeriesCollection(12).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(13).Values = wsCalcul.Range(startRangeN, endRangeN).Resize
        wsGraphique.SeriesCollection(13).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize

        wsGraphique.Protect Password:="CPV"
        wsCalcul.Protect Password:="CPV"
  Next j

ActiveWorkbook.Protect Password:="CPV"

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

et UserForm:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
     If (0 <= ComboBox1.ListIndex) And (ComboBox1.ListIndex <= ComboBox2.ListIndex) Then
     iDébut = ComboBox1.ListIndex + 1     'à partir de cet élément pour les séries
     iFin = ComboBox2.ListIndex + 1     'jusqu'à cet élément
     If 1 <= iDébut And iDébut <= iFin Then
          UpdateGraph
          Unload Me
        End If
     End If
Application.Goto Reference:=Worksheets("Tableau de saisie").Range("K3")
Application.ScreenUpdating = True
End Sub
Le 10/03/2023 à 15:25

Re,

J'ai resimplifié le code, mais j'ai une erreur d'exécution 1004 sur la ligne suivante à la deuxième itération, idem la combobox2 n'est apparemment pas reconnue :

wsGraphique.SeriesCollection(1).Values = wsCalcul.Range(startRangeB, endRangeB).Resize
Public Sub UpdateGraph()

' Désactiver les événements pour accélérer l'exécution
Application.EnableEvents = False
Application.ScreenUpdating = False

ActiveWorkbook.Unprotect Password:="CPV"

    Dim wsGraphique As Chart
    Dim wsCalcul As Worksheet
    Dim startRangeA As Range
    Dim endRangeA As Range
    Dim startRangeB As Range
    Dim endRangeB As Range
    Dim startRangeC As Range
    Dim endRangeC As Range
    Dim startRangeD As Range
    Dim endRangeD As Range
    Dim startRangeE As Range
    Dim endRangeE As Range
    Dim startRangeF As Range
    Dim endRangeF As Range
    Dim startRangeG As Range
    Dim endRangeG As Range
    Dim startRangeH As Range
    Dim endRangeH As Range
    Dim startRangeI As Range
    Dim endRangeI As Range
    Dim startRangeJ As Range
    Dim endRangeJ As Range
    Dim startRangeK As Range
    Dim endRangeK As Range
    Dim startRangeL As Range
    Dim endRangeL As Range
    Dim startRangeM As Range
    Dim endRangeM As Range
    Dim startRangeN As Range
    Dim endRangeN As Range
    Dim j As Integer

For j = 1 To ThisWorkbook.Charts.Count
    Set wsGraphique = ThisWorkbook.Charts(j)
    wsGraphique.Unprotect Password:="CPV"

    Set wsCalcul = ThisWorkbook.Worksheets(j + 2)
    wsCalcul.Unprotect Password:="CPV"

    ' Chercher la première correspondance dans la colonne A
For Each cell In wsCalcul.Range("A2:A201")
    If cell.Value = UserForm4.ComboBox1 Then
        Set startRangeA = cell
    MsgBox ("startRangeA :" & startRangeA)
    End If
    If cell.Value = UserForm4.ComboBox2 Then
        Set endRangeA = cell
    MsgBox ("endRangeA :" & endRangeA)
    End If
    If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
        Exit For ' Sort de la boucle si les deux ranges ont été définis
    End If
Next cell

' Si la première correspondance a été trouvée, chercher la correspondance dans la colonne B
If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row = startRangeA.Row Then
                Set startRangeB = cell.Offset(0, 1)
                Set startRangeC = cell.Offset(0, 2)
                Set startRangeD = cell.Offset(0, 3)
                Set startRangeE = cell.Offset(0, 4)
                Set startRangeF = cell.Offset(0, 5)
                Set startRangeG = cell.Offset(0, 6)
                Set startRangeH = cell.Offset(0, 7)
                Set startRangeI = cell.Offset(0, 8)
                Set startRangeJ = cell.Offset(0, 9)
                Set startRangeK = cell.Offset(0, 10)
                Set startRangeL = cell.Offset(0, 11)
                Set startRangeM = cell.Offset(0, 12)
                Set startRangeN = cell.Offset(0, 13)
            End If
        If cell.Row = endRangeA.Row Then
                Set endRangeB = cell.Offset(0, 1)
                Set endRangeC = cell.Offset(0, 2)
                Set endRangeD = cell.Offset(0, 3)
                Set endRangeE = cell.Offset(0, 4)
                Set endRangeF = cell.Offset(0, 5)
                Set endRangeG = cell.Offset(0, 6)
                Set endRangeH = cell.Offset(0, 7)
                Set endRangeI = cell.Offset(0, 8)
                Set endRangeJ = cell.Offset(0, 9)
                Set endRangeK = cell.Offset(0, 10)
                Set endRangeL = cell.Offset(0, 11)
                Set endRangeM = cell.Offset(0, 12)
                Set endRangeN = cell.Offset(0, 13)
        End If
    Next cell
End If

        wsGraphique.Unprotect Password:="CPV"
        wsGraphique.SeriesCollection(1).Values = wsCalcul.Range(startRangeB, endRangeB).Resize
        wsGraphique.SeriesCollection(1).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(2).Values = wsCalcul.Range(startRangeC, endRangeC).Resize
        wsGraphique.SeriesCollection(2).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(3).Values = wsCalcul.Range(startRangeD, endRangeD).Resize
        wsGraphique.SeriesCollection(3).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(4).Values = wsCalcul.Range(startRangeE, endRangeE).Resize
        wsGraphique.SeriesCollection(4).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(5).Values = wsCalcul.Range(startRangeF, endRangeF).Resize
        wsGraphique.SeriesCollection(5).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(6).Values = wsCalcul.Range(startRangeG, endRangeG).Resize
        wsGraphique.SeriesCollection(6).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(7).Values = wsCalcul.Range(startRangeH, endRangeH).Resize
        wsGraphique.SeriesCollection(7).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(8).Values = wsCalcul.Range(startRangeI, endRangeI).Resize
        wsGraphique.SeriesCollection(8).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(9).Values = wsCalcul.Range(startRangeJ, endRangeJ).Resize
        wsGraphique.SeriesCollection(9).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(10).Values = wsCalcul.Range(startRangeK, endRangeK).Resize
        wsGraphique.SeriesCollection(10).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(11).Values = wsCalcul.Range(startRangeL, endRangeL).Resize
        wsGraphique.SeriesCollection(11).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(12).Values = wsCalcul.Range(startRangeM, endRangeM).Resize
        wsGraphique.SeriesCollection(12).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(13).Values = wsCalcul.Range(startRangeN, endRangeN).Resize
        wsGraphique.SeriesCollection(13).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize

        wsGraphique.Protect Password:="CPV"
        wsCalcul.Protect Password:="CPV"
  Next j

ActiveWorkbook.Protect Password:="CPV"

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
Le 10/03/2023 à 16:28

Re,

Enfin trouvé !!

Voilà la code modifié et fonctionnel (si ça intéresse quelqu'un !)

Module :

Public Sub UpdateGraph()

' Désactiver les événements pour accélérer l'exécution
Application.EnableEvents = False
Application.ScreenUpdating = False

ActiveWorkbook.Unprotect Password:="CPV"

    Dim wsGraphique As Chart
    Dim wsCalcul As Worksheet
    Dim startRangeA As Range
    Dim endRangeA As Range
    Dim startRangeB As Range
    Dim endRangeB As Range
    Dim startRangeC As Range
    Dim endRangeC As Range
    Dim startRangeD As Range
    Dim endRangeD As Range
    Dim startRangeE As Range
    Dim endRangeE As Range
    Dim startRangeF As Range
    Dim endRangeF As Range
    Dim startRangeG As Range
    Dim endRangeG As Range
    Dim startRangeH As Range
    Dim endRangeH As Range
    Dim startRangeI As Range
    Dim endRangeI As Range
    Dim startRangeJ As Range
    Dim endRangeJ As Range
    Dim startRangeK As Range
    Dim endRangeK As Range
    Dim startRangeL As Range
    Dim endRangeL As Range
    Dim startRangeM As Range
    Dim endRangeM As Range
    Dim startRangeN As Range
    Dim endRangeN As Range
    Dim j As Integer

For j = 1 To ThisWorkbook.Charts.Count
    Set wsGraphique = ThisWorkbook.Charts(j)
    wsGraphique.Unprotect Password:="CPV"

    Set wsCalcul = ThisWorkbook.Worksheets(j + 2)
    wsCalcul.Unprotect Password:="CPV"

    ' Chercher la première correspondance dans la colonne A
For Each cell In wsCalcul.Range("A2:A201")
    If cell.Value = UserForm4.ComboBox1 Then
        Set startRangeA = cell
    End If
Next cell
For Each cell In wsCalcul.Range("A2:A201")
    If cell.Value = UserForm4.ComboBox2 Then
        Set endRangeA = cell
    End If
Next cell

' Si la première correspondance a été trouvée, chercher la correspondance dans la colonne B
If Not startRangeA Is Nothing And Not endRangeA Is Nothing Then
    For Each cell In wsCalcul.Range("A2:A201")
        If cell.Row = startRangeA.Row Then
                Set startRangeB = cell.Offset(0, 1)
                Set startRangeC = cell.Offset(0, 2)
                Set startRangeD = cell.Offset(0, 3)
                Set startRangeE = cell.Offset(0, 4)
                Set startRangeF = cell.Offset(0, 5)
                Set startRangeG = cell.Offset(0, 6)
                Set startRangeH = cell.Offset(0, 7)
                Set startRangeI = cell.Offset(0, 8)
                Set startRangeJ = cell.Offset(0, 9)
                Set startRangeK = cell.Offset(0, 10)
                Set startRangeL = cell.Offset(0, 11)
                Set startRangeM = cell.Offset(0, 12)
                Set startRangeN = cell.Offset(0, 13)
            End If
        If cell.Row = endRangeA.Row Then
                Set endRangeB = cell.Offset(0, 1)
                Set endRangeC = cell.Offset(0, 2)
                Set endRangeD = cell.Offset(0, 3)
                Set endRangeE = cell.Offset(0, 4)
                Set endRangeF = cell.Offset(0, 5)
                Set endRangeG = cell.Offset(0, 6)
                Set endRangeH = cell.Offset(0, 7)
                Set endRangeI = cell.Offset(0, 8)
                Set endRangeJ = cell.Offset(0, 9)
                Set endRangeK = cell.Offset(0, 10)
                Set endRangeL = cell.Offset(0, 11)
                Set endRangeM = cell.Offset(0, 12)
                Set endRangeN = cell.Offset(0, 13)
        End If
    Next cell
End If

        wsGraphique.Unprotect Password:="CPV"
        wsGraphique.SeriesCollection(1).Values = wsCalcul.Range(startRangeB, endRangeB).Resize
        wsGraphique.SeriesCollection(1).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(2).Values = wsCalcul.Range(startRangeC, endRangeC).Resize
        wsGraphique.SeriesCollection(2).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(3).Values = wsCalcul.Range(startRangeD, endRangeD).Resize
        wsGraphique.SeriesCollection(3).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(4).Values = wsCalcul.Range(startRangeE, endRangeE).Resize
        wsGraphique.SeriesCollection(4).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(5).Values = wsCalcul.Range(startRangeF, endRangeF).Resize
        wsGraphique.SeriesCollection(5).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(6).Values = wsCalcul.Range(startRangeG, endRangeG).Resize
        wsGraphique.SeriesCollection(6).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(7).Values = wsCalcul.Range(startRangeH, endRangeH).Resize
        wsGraphique.SeriesCollection(7).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(8).Values = wsCalcul.Range(startRangeI, endRangeI).Resize
        wsGraphique.SeriesCollection(8).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(9).Values = wsCalcul.Range(startRangeJ, endRangeJ).Resize
        wsGraphique.SeriesCollection(9).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(10).Values = wsCalcul.Range(startRangeK, endRangeK).Resize
        wsGraphique.SeriesCollection(10).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(11).Values = wsCalcul.Range(startRangeL, endRangeL).Resize
        wsGraphique.SeriesCollection(11).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(12).Values = wsCalcul.Range(startRangeM, endRangeM).Resize
        wsGraphique.SeriesCollection(12).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize
        wsGraphique.SeriesCollection(13).Values = wsCalcul.Range(startRangeN, endRangeN).Resize
        wsGraphique.SeriesCollection(13).XValues = wsCalcul.Range(startRangeA, endRangeA).Resize

        wsGraphique.Protect Password:="CPV"
        wsCalcul.Protect Password:="CPV"
  Next j

ActiveWorkbook.Protect Password:="CPV"

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

UserForm:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If (0 <= ComboBox1.ListIndex) And (ComboBox1.ListIndex <= ComboBox2.ListIndex) Then
  iDébut = ComboBox1.ListIndex + 1     'à partir de cet élément pour les séries
  iFin = ComboBox2.ListIndex + 1     'jusqu'à cet élément
     If 1 <= iDébut And iDébut <= iFin Then
          UpdateGraph
          Unload Me
     End If
End If
Application.Goto Reference:=Worksheets("Tableau de saisie").Range("K3")
Application.ScreenUpdating = True
End Sub

Merci BsAlv pour votre code Userform qui ma bien aidé !

Cordialement !

Arka

Rechercher des sujets similaires à "modifier plage axe abscisses graphique vba"