Créer un graph avec FIND

**MaelB** · 04/12/2012, 10h46

Bonjour à tous!

Tout d'abord je tiens à préciser que je débute sur vba et que la solution à ce problème devrait être relativement simple... mais je ne parviens malheureusement pas à la trouver seule ou grâce aux tutoriels.

Je voudrait créer un graph à partir de la fonction FIND. Je m'explique. Je doit gérer des données venant de plusieurs services. J'ai réussit à tout regrouper dans un tableau de synthèse ("SYN") à partir duquel toutes les infos sont disponibles pour faire le graph.

Extrait:

Semaines  	41	42	43	44	45	46

Collage		62%	70%	59%	74%	95%	63%	
Commercial			92%	92%	100%	100%	
Finition				56%	80%	80%	

Moyenne A	60%	66%	68%	62%	62%	79%
Moyenne B	78%	67%	65%	74%	69%	75%

Dans ce graph, je dois avoir les semaines en abscisses, les ordonnées de 0% à 100% et je dois voir les deux moyennes et le service choisi par l'utilisateur. Le problème se situe donc au niveau du domaine de définition du graph.

Voici mon code:

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
Private Sub Cmd_Graph_Click()
 
'Trouver la ligne de l'Unité/Service dans le tableau "SYN"
Set U = Sheets("SYN").Range("A:A").Find(Label_Cbo_UnitServ.Caption)
    If U Is Nothing Then
    MsgBox "UN PROBLEME EST SURVENU. Veuillez contacter un support"
    End If
 
'Jusque là pas de problème, il me trouve bien le service dans la colonne A
 
    If Not U Is Nothing Then
 
'Créer le graph
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlXYScatterSmooth
        ActiveChart.SetSourceData Source:=Range("U.Row;SYN!$28:$29")
 
'Déplacer le graph vers une nouvelle feuille (graph horizontal)
        ActiveChart.Location Where:=xlLocationAsNewSheet
 
'Mise en forme du graph
        ActiveChart.Axes(xlCategory).MinimumScale = 39
        ActiveChart.Axes(xlCategory).MaximumScale = 52
        ActiveChart.Axes(xlValue).MinimumScale = 0
        ActiveChart.Axes(xlValue).MaximumScale = 100
 
        ActiveChart.ApplyLayout (8)
        ActiveChart.ChartTitle.Text = "Audit Rangement-Propreté"
 
End Sub

Encore une fois, la problème est peut-être très facile à résoudre mais je tourne en rond.

Merci d'avance!

MaelB

**mercatog** · 04/12/2012, 13h41

Si tu as en ligne 1 de ta feuille SYN les semaines

Essaies ce code

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
Private Sub Cmd_Graph_Click()
Dim U As Range
Dim Sh As Worksheet
Dim Ch As Chart
Dim LastCol
 
Set Sh = ThisWorkbook.Worksheets("SYN")
Set U = Sh.Range("A:A").Find(Label_Cbo_UnitServ.Caption, LookIn:=xlValues, lookat:=xlWhole)
 
If U Is Nothing Then
    MsgBox "UN PROBLEME EST SURVENU. Veuillez contacter un support"
Else
    LastCol = Sh.Cells(U.Row, Sh.Columns.Count).End(xlToLeft).Column
        Union(U.Resize(1, LastCol), Sh.Range("A28").Resize(2, LastCol)).Select
    Set Ch = ThisWorkbook.Charts.Add
    With Ch
        .ChartType = xlXYScatterSmooth
'Adapte A1 ci-après par la cellule contenant Semaines
        .SetSourceData Source:=Union(Sh.Range("A1").Resize(1, LastCol), U.Resize(1, LastCol), Sh.Range("A28").Resize(2, LastCol))
        'Mise en forme du graph
        .Axes(xlCategory).MinimumScale = 39
        .Axes(xlCategory).MaximumScale = 52
        .Axes(xlValue).MinimumScale = 0
        .Axes(xlValue).MaximumScale = 1
        .ApplyLayout 8
        .ChartTitle.Text = "Audit Rangement-Propreté"
    End With
    Set Ch = Nothing
    Set U = Nothing
End If
Set Sh = Nothing
End Sub

**MaelB** · 04/12/2012, 14h43

J'ai bien les semaines en ligne 1 et "A1" et bien la cellule "Semaines".

Ton code fonctionne presque. Tel quel, j'ai un problème sur:

Code :

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

1
2
3
4
5
6
7
8
9
If U Is Nothing Then
    MsgBox "UN PROBLEME EST SURVENU. Veuillez contacter un support"
Else
    LastCol = Sh.Cells(U.Row, Sh.Columns.Count).End(xlToLeft).Column
        Union(U.Resize(1, LastCol), Sh.Range("A28").Resize(2, LastCol)).Select
    Set Ch = ThisWorkbook.Charts.Add
    With Ch
        .ChartType = xlXYScatterSmooth
        .SetSourceData Source:=Union(Sh.Range("A1").Resize(1, LastCol), U.Resize(1, LastCol), Sh.Range("A28").Resize(2, LastCol))

Il me dit: "La méthode Select de la classe Range a échoué".

J'ai fais quelques test et voici le résultat le plus proche:

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
Private Sub Cmd_Graph_Click()
'Imprime un graph personnalisé grâce au tableau "SYN"
 
Dim U As Range
Dim Sh As Worksheet
Dim Ch As Chart
 
Set Sh = ThisWorkbook.Worksheets("SYN")
Set U = Sh.Range("A:A").Find(Label_Cbo_UnitServ.Caption, LookIn:=xlValues, lookat:=xlWhole)
 
If U Is Nothing Then
    MsgBox "UN PROBLEME EST SURVENU. Veuillez contacter un support"
Else
    Set Ch = ThisWorkbook.Charts.Add
    With Ch
        .ChartType = xlXYScatterSmooth
'Adapte A1 ci-après par la cellule contenant Semaines
        .SetSourceData Source:=Union(Sh.Range("A1").Resize(1, 16), U.Resize(1, 16), Sh.Range("A28").Resize(2, 16))
        'Mise en forme du graph
        .Axes(xlCategory).MinimumScale = 39
        .Axes(xlCategory).MaximumScale = 52
        .Axes(xlValue).MinimumScale = 0
        .Axes(xlValue).MaximumScale = 1
        .ApplyLayout 8
        .ChartTitle.Text = "Audit Rangement-Propreté"
    End With
    Set Ch = Nothing
    Set U = Nothing
End If
Set Sh = Nothing
 
End Sub

Mais il ne tiens pas compte du nombre de semaine. L'axe des abscisses va de 1 à 16 (il y a 16 colonnes).
Pour l'année 2013, ça marchera puisque je commencerai bien à la semaine 1 mais je ne pourrai pas rajouter la moyenne de 2012 (en semaine 0 par exemple) sinon ça décalera tout. Et puis il reste le problème de la fin de l'année 2012...

Je suis désolée de te déranger encore mais je suis vraiment débutante (de 1 semaine environ)

**mercatog** · 04/12/2012, 15h06

Je n'ai pas mis de Select mais je ne vois pas pourquoi tu as ajouté la ligne de code avec ton Select insensé.

Est ce que tu peux mettre en PJ seulement les données de ta feuille SYN en ayant la gentillesse de supprimer les données confidentielles. (pas besoin de tout ton fichier)

**MaelB** · 04/12/2012, 17h36

Tout d'abord, merci mercatog pour ton aide.

On s'y est mis à plusieurs de mon coté mais on a finalement trouvé la solution. Donc, pour info:

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
Private Sub Cmd_Graph_Click()
'Imprime un graph personnalisé grâce au tableau "SYN"

'Trouver la ligne désirée (selon un Label) dans le tableau "SYN"
Set U = Sheets("SYN").Range("A:A").Find(Label.Caption)
    If U Is Nothing Then
    MsgBox "UN PROBLEME EST SURVENU."
    End If

    If Not U Is Nothing Then
        'Créer le graph
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlXYScatterSmooth
        ActiveChart.SetSourceData Source:=Union(Sheets("SYN").Range("$1:$1"), Sheets("SYN").Rows(U.Row), Sheets("SYN").Range("$28:$29"))
        
        'Déplacer le graph vers une nouvelle feuille (graph horizontal) nommée en fonction de U.
        ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=U.Text

        'Mise en forme du graph
        ActiveChart.Axes(xlCategory).MinimumScale = 39
        ActiveChart.Axes(xlCategory).MaximumScale = 52
        ActiveChart.Axes(xlValue).MinimumScale = 0
        ActiveChart.Axes(xlValue).MaximumScale = 1
        ActiveChart.Axes(xlValue).Select
        Selection.TickLabels.NumberFormat = "0%"
        
        ActiveChart.ApplyLayout (8)
        ActiveChart.ChartTitle.Text = "Titre"

        'Impression centrée sur la page A4
        With ActiveSheet
            .PageSetup.CenterHorizontally = True
            .PageSetup.CenterVertically = True
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = 1
            .PrintOut
        End With

        'Suppression de la page crée
        ActiveWindow.SelectedSheets.Delete

    End If

End Sub

Voilà! Pour ceux que ça pourrait aider...

**mercatog** · 04/12/2012, 18h43

Dommage, tu aurais pris la structure du code sans les Activesheet ni les Activechart ni même les Select et en plus en utilisant des variables objet.
Plus tard quand tu apprendras plus, tu en rigoleras

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
Private Sub Cmd_Graph_Click()
Dim U As Range
Dim Sh As Worksheet
Dim Ch As Chart
 
Set Sh = ThisWorkbook.Worksheets("SYN")
Set U = Sh.Range("A:A").Find(Label_Cbo_UnitServ.Caption, LookIn:=xlValues, lookat:=xlWhole)
 
If U Is Nothing Then
    MsgBox "UN PROBLEME EST SURVENU. Veuillez contacter un support"
Else
    Set Ch = ThisWorkbook.Charts.Add
    With Ch
        .ChartType = xlXYScatterSmooth
        .SetSourceData Source:=Union(Sh.Range("1:1"), Sh.Rows(U.Row), Sh.Range("28:29"))
        With .Axes(xlCategory)
            .MinimumScale = 39
            .MaximumScale = 52
        End With
        With .Axes(xlValue)
            .MinimumScale = 0
            .MaximumScale = 1
            .TickLabels.NumberFormat = "0%"
        End With
        .ApplyLayout 8
        .ChartTitle.Text = "Audit Rangement-Propreté"
        '....
    End With
    Set Ch = Nothing
    Set U = Nothing
End If
Set Sh = Nothing
End Sub

**MaelB** · 05/12/2012, 12h03

Bonjour,

Je te crois sur parole, et je ne doute pas un instant que je me trouverai bête dans quelques années. Mais avec seulement 1 semaine et 3 jours de VBA dans les pattes... Disons que je suis un peu limitée dans mes choix!

J'ai finalement choisi le dernier code que tu as mis. Il fonctionne parfaitement bien, et surtout je le comprend...

Merci encore pour ton aide précieuse!

Cdt,

MaelB

Créer un graph avec FIND

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager