Masquer les en-têtes et cellules inutiles

Invité · 23/06/2014, 10h08

Salut à tous

Bon je suis dans la création automatique de plusieurs camemberts. Pour l'instant il s'affiche, j'en suis content

Cependant, il reste des valeurs qui, par certains moments, renvoient 0. J'aimerais, lorsque c'est le cas, cacher la colonne correspondante, c'est à dire masquer la valeur dans la cellule et l'en tete. Bah oui, avoir un 0% qui s'affiche dans le graphique, c'est pas très joli ^^

Je vous joins mon code fonctionnel pour l'instant afin que vous puissiez m'aider au mieux !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub Macro3()
'
' Macro3 Macro
'
Dim NbLig As Integer
    NbLig = Cells.SpecialCells(xlCellTypeLastCell).Row
 
Sheets.Add After:=ActiveSheet    'création d'une nouvelle feuille après la feuille active '
 
For i = 2 To NbLig
 
    ActiveSheet.Shapes.AddChart2(262, xl3DPie).Select
    ActiveChart.SetSourceData Source:=Sheets("fichier").Range("$A$1:$E$1,$A" & i & ":$E" & i & "")
    ActiveChart.FullSeriesCollection(1).Name = "=fichier!$F" & i
    ActiveChart.FullSeriesCollection(1).Select
    Selection.Explosion = 40
 
Next i
 
End Sub

je vous donne également l'aperçu du tableau dans lequel je vais piocher mes données. Je précise que la taille de ce tableau n'est pas fixe, d’où l'utilisation d'un for

Nom : tableau.PNG
Affichages : 251
Taille : 3,8 Ko

**Daniel.C** · 23/06/2014, 10h53

Bonjour,

Essaie comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Macro3()
Dim NbLig As Integer, Graph As Shape, Valeurs() As Single, xValeurs() As String, Ctr As Integer
    NbLig = Cells.SpecialCells(xlCellTypeLastCell).Row
    Sheets.Add After:=ActiveSheet    'création d'une nouvelle feuille après la feuille active '
For i = 2 To NbLig
    ReDim Valeurs(1)
    ReDim xValeurs(1)
    Ctr = 0
    Set Graph = ActiveSheet.Shapes.AddChart2(262, xl3DPie)
    With Graph.Chart
        For j = 1 To 4
            If Sheets("fichier").Cells(i, j) > 0 Then
                Ctr = Ctr + 1
                ReDim Preserve Valeurs(Ctr)
                ReDim Preserve xValeurs(Ctr)
                Valeurs(Ctr) = Sheets("fichier").Cells(i, j)
                xValeurs(Ctr) = Sheets("fichier").Cells(1, j)
            End If
        Next j
        .SeriesCollection.NewSeries
        With .SeriesCollection(1)
            .Values = Valeurs
            .XValues = xValeurs
            .Explosion = 40
        End With
    End With
Next i
 
End Sub

Invité · 23/06/2014, 14h19

Je viens d'essayer ton code, j'ai reçu une erreur :

Erreur d'exécution n° 13 :

Incompatibilité de type.

L'erreur viendrait de cette ligne :

Valeurs(Ctr) = Sheets("fichier").Cells(i, j)

Je ne comprend pas ce que devrait faire ton code ^^

**Daniel.C** · 23/06/2014, 14h29

Je ne comprend pas ce que devrait faire ton code ^^

Il récupère les valeurs non nulles et les entêtes correspondants dans les variables Valeurs et xValeurs et construit la série avec.

Regarde le classeur joint : jeremjerem23.xls

Invité · 23/06/2014, 14h42

J'avais cru comprendre le principe de ton code en effet, mais j'ai une erreur quand j'essaie de lancer ta macro avec mon fichier xls.. c'est embetant, étant donné que le résultat que tu obtiens est ce dont j'ai besoin ^^

**Daniel.C** · 23/06/2014, 17h10

Est-ce que tu peux :
1. préciser ta version d'EXcel
2. mettre ton classeur - sans données confidentielles en pièce jointe.

**Daniel.C** · 24/06/2014, 10h11

Oups, j'ai oublié le plus important: tu dois mettre la ligne suivante en tête de module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Base 1

Invité · 24/06/2014, 14h10

Salut Daniel,

Tout d'abord, merci de m'aider concernant mon problème !

La version d'Excel que j'utilise est Excel 2013. J'exporte également mes données sur Word 2013 à titre d'information.

J'ai donc coller ça en macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
Sub Macro4()
Option Base 1
Dim NbLig As Integer, Graph As Shape, Valeurs() As Single, xValeurs() As String, Ctr As Integer
    NbLig = Cells.SpecialCells(xlCellTypeLastCell).Row
    Sheets.Add After:=ActiveSheet    'création d'une nouvelle feuille après la feuille active '
For i = 2 To NbLig
    ReDim Valeurs(1)
    ReDim xValeurs(1)
    Ctr = 0
    Set Graph = ActiveSheet.Shapes.AddChart2(262, xl3DPie)
    With Graph.Chart
        For j = 1 To 4
            If Sheets("fichier").Cells(i, j) > 0 Then
                Ctr = Ctr + 1
                ReDim Preserve Valeurs(Ctr)
                ReDim Preserve xValeurs(Ctr)
                Valeurs(Ctr) = Sheets("fichier").Cells(i, j)
                xValeurs(Ctr) = Sheets("fichier").Cells(1, j)
            End If
        Next j
        .SeriesCollection.NewSeries
        With .SeriesCollection(1)
            .Values = Valeurs
            .XValues = xValeurs
            .Explosion = 40
        End With
    End With
Next i
 
End Sub

Cependant, j'obtient maintenant l'erreur suivante :
Instruction incorrecte dans une procédure

Je te joins le fichier csv que j'ai actuellement. Seul soucis je l'ai transformé en fichier xlsx car je ne peux envoyer de fichiers csv. fichier.xlsx

**Daniel.C** · 24/06/2014, 14h31

Nan !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Base 1

doit être au-dessus de toutes macros et fonctions dans le module :

Nom : Capture.JPG
Affichages : 235
Taille : 15,8 Ko

Invité · 24/06/2014, 14h35

Hum, Erreur d'exécution '13' :
Incompatibilité de type de nouveau... :/

J'ai bien ton option base 1 seul pourtant ^^ je ne comprend pas

**Daniel.C** · 24/06/2014, 14h50

En fait, contrairement à ton premier exemple, tes cellules ne contenaient pas des zéros, mais des espaces.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Base 1
 
Sub Macro4()
Dim NbLig As Integer, Graph As Shape, Valeurs() As Single, xValeurs() As String, Ctr As Integer
    NbLig = Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To NbLig
    ReDim Valeurs(1)
    ReDim xValeurs(1)
    Ctr = 0
    Sheets.Add After:=ActiveSheet    'création d'une nouvelle feuille après la feuille active '
    Set Graph = ActiveSheet.Shapes.AddChart2(262, xl3DPie)
    With Graph.Chart
        For j = 1 To 4
            'If Sheets("fichier").Cells(i, j) > 0 Then
            Var = Sheets("fichier").Cells(i, j)
            If Sheets("fichier").Cells(i, j) > 0 And IsNumeric(Sheets("fichier").Cells(i, j)) Then
                Ctr = Ctr + 1
                ReDim Preserve Valeurs(Ctr)
                ReDim Preserve xValeurs(Ctr)
                Valeurs(Ctr) = Sheets("fichier").Cells(i, j)
                xValeurs(Ctr) = Sheets("fichier").Cells(1, j)
            End If
        Next j
        .SeriesCollection.NewSeries
        With .SeriesCollection(1)
            .Values = Valeurs
            .XValues = xValeurs
            .Explosion = 40
        End With
    End With
Next i
 
End Sub

Invité · 25/06/2014, 08h25

Salut Daniel,

C'est presque parfait !

Une dernière chose, après je te laisse tranquille ! J'ai réussi à mettre mes titres avec la colonne F, donc ça c'est réglé. Mais maintenant, j'aurais aimé définir une couleur de partie de camembert en fonction de la colonne que j'extraie. En gros, je voudrais faire :

- une partie verte pour la colonne "disponible"
- une partie rouge pour la colonne "indisponible"
- une partie bleu pour la colonne "introuvable"
- une partie grise pour la colonne "indéterminée"
- une partie violette pour la colonne "maintenance"

Pour l'instant, c'est assez embêtant, ça va etre bon pour le vert et le rouge si j'ai deux entrées dispo et indispo. Mais si j'ai deux entrées introuvable et maintenance, j'aurais aussi les couleurs vert et rouge ... Tu penses avoir une idée ? (je devrais peut etre recréer un sujet avec ce message non ? ^^)

Invité · 25/06/2014, 09h40

up svp !

**Daniel.C** · 25/06/2014, 10h03

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Base 1
 
Sub Macro4()
Dim NbLig As Integer, Graph As Shape, Valeurs() As Single, xValeurs() As String, Ctr As Integer
Dim Couleur() As Integer, Couleurs As Variant
Couleurs = Array(4, 3, 32, 15, 17)
NbLig = Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To NbLig
    ReDim Valeurs(1)
    ReDim xValeurs(1)
    ReDim Couleur(1)
    Ctr = 0
    Sheets.Add After:=ActiveSheet    'création d'une nouvelle feuille après la feuille active '
    Set Graph = ActiveSheet.Shapes.AddChart2(262, xl3DPie)
    With Graph.Chart
        For j = 1 To 5
            If Sheets("fichier").Cells(i, j) > 0 And IsNumeric(Sheets("fichier").Cells(i, j)) Then
                Ctr = Ctr + 1
                ReDim Preserve Valeurs(Ctr)
                ReDim Preserve xValeurs(Ctr)
                ReDim Preserve Couleur(Ctr)
                Valeurs(Ctr) = Sheets("fichier").Cells(i, j)
                xValeurs(Ctr) = Sheets("fichier").Cells(1, j)
                Couleur(Ctr) = Application.Index(Couleurs, j)
            End If
        Next j
        .ChartTitle.Text = Sheets("fichier").Cells(i, 6).Value
        .SeriesCollection.NewSeries
        With .SeriesCollection(1)
            .Values = Valeurs
            .XValues = xValeurs
            .Explosion = 40
            For k = 1 To UBound(Couleur)
                .Points(k).Interior.ColorIndex = Couleur(k)
            Next k
        End With
    End With
Next i
 
End Sub

Invité · 25/06/2014, 10h27

Salut Daniel,

merci beaucoup, c'est exactement ce que je recherchais !

Un tout dernier point, et ce sera complet. Pour mettre les pourcentages, sait tu comment je devrais procéder ?

par exemple, si dispo est à 70%, indispo a 20% et maintenance à 10%, comment je pourrais faire pour afficher les taux en plus des parts du camembert ?

**Daniel.C** · 25/06/2014, 11h38

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Base 1
 
Sub Macro4()
Dim NbLig As Integer, Graph As Shape, Valeurs() As Single, xValeurs() As String, Ctr As Integer
Dim Couleur() As Integer, Couleurs As Variant
Couleurs = Array(4, 3, 32, 15, 17)
NbLig = Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To NbLig
    ReDim Valeurs(1)
    ReDim xValeurs(1)
    ReDim Couleur(1)
    Ctr = 0
    Sheets.Add After:=ActiveSheet    'création d'une nouvelle feuille après la feuille active '
    Set Graph = ActiveSheet.Shapes.AddChart2(262, xl3DPie)
    With Graph.Chart
        For j = 1 To 5
            If Sheets("fichier").Cells(i, j) > 0 And IsNumeric(Sheets("fichier").Cells(i, j)) Then
                Ctr = Ctr + 1
                ReDim Preserve Valeurs(Ctr)
                ReDim Preserve xValeurs(Ctr)
                ReDim Preserve Couleur(Ctr)
                Valeurs(Ctr) = Sheets("fichier").Cells(i, j)
                xValeurs(Ctr) = Sheets("fichier").Cells(1, j)
                Couleur(Ctr) = Application.Index(Couleurs, j)
            End If
        Next j
        .ChartTitle.Text = Sheets("fichier").Cells(i, 6).Value
        .SeriesCollection.NewSeries
        With .SeriesCollection(1)
            .Values = Valeurs
            .XValues = xValeurs
            .Explosion = 40
            For k = 1 To UBound(Couleur)
                .Points(k).Interior.ColorIndex = Couleur(k)
            Next k
            .ApplyDataLabels
            With .DataLabels.Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 255, 255)
                .Solid
            End With
            With .DataLabels
                .ShowPercentage = True
                .ShowValue = False
            End With
        End With
    End With
Next i
 
End Sub

Invité · 25/06/2014, 11h50

Whaou .... franchement Daniel, je te tire un grand chapeau ! c'est parfait tout ce que tu m'as fais, merci mille fois !

Je passe en résolu, tu as tout résolu tout seul, merci beaucoup

Bonne journée

Masquer les en-têtes et cellules inutiles

Excel

Discussions similaires

Partager

Partager