Insérer un bouton sur une feuille graphique

Résolu/Fermé
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 - 13 oct. 2015 à 16:38
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 - 13 oct. 2015 à 16:41
Bonjour,

J'ai trouvé une excellente macro qui insère sans problème un bouton sur une feuille graphique d'excel :

Sub TEST()

With Sheets(1).Shapes
With .AddFormControl(x, 50, 50, 50, 50)
.Name = "Retour"
.OLEFormat.Object.Caption = "Retour"
.OLEFormat.Object.OnAction = "BOUTON"
With .OLEFormat.Object.Font
.Name = "Arial"
.Bold = True
.ColorIndex = 3
End With
End With
End With

End Sub


Seulement voilà, je l'intègre à ma macro principale :

Sub BOUTON()

Application.DisplayAlerts = False

Sheets(1).Delete
Sheets("Données").Delete

Application.DisplayAlerts = True

End Sub


Sub Code()

Dim DL As Long, DL2 As Long, Début As String, Fin As String, Produit As String, DC As Long, objChart As Chart, objRange As Range, MaSerie As Series, Obj As Object, Code As String

Produit = InputBox("Entrer le nom du produit à analyser")

If Produit = "" Then Exit Sub

Début = InputBox("Entrer le numéro de la première semaine à analyser <sans le S, (exemple 1, 12)>")

If Début = "" Then Exit Sub

Fin = InputBox("Entrer le numéro de la dernière semaine à analyser <sans le S, (exemple 1, 12)>")

If Fin = "" Then Exit Sub

Set FEUILLE_GRAPH = Sheets.Add
FEUILLE_GRAPH.Name = "Données"

DL = Sheets("Base").Cells(Application.Rows.Count, 1).End(xlUp).Row 'Si la colonne 1 est bien remplie jusqu'à la fin du tableau

DC = Sheets("Base").Cells(1, Application.Columns.Count).End(xlToLeft).Column 'si la ligne 1 est bien remplie jusqu'à la fin du tableau

For i = 2 To DL 'Si produits vont de la ligne 2 à la ligne xxx
For j = 2 To DC 'Les les semaines vont de la colonne 2 à la ligne xxx

If Sheets("Base").Range("A" & i).Value = Produit Then
    If Right(Sheets("Base").Cells(1, j), 2) >= Val(Début) Then
        If Right(Sheets("Base").Cells(1, j), 2) <= Val(Fin) Then
            Valeurs = Valeurs & "Résultats pour la SEMAINE " & Right(Sheets("Base").Cells(1, j), 2) & ":           " & Sheets("Base").Cells(i, j).Value * 100 & "%" & vbLf
            x = x + 1
            Sheets("Données").Cells(x, 1) = Right(Sheets("Base").Cells(1, j), 2)
            Sheets("Base").Cells(i, j).Copy Sheets("Données").Cells(x, 2)
        End If
    End If
End If

Next j
Next i

DL2 = Sheets("Données").Cells(Application.Rows.Count, 1).End(xlUp).Row

Sheets("Données").Columns("A:B").Sort Key1:=Range("A1")

Set objRange = Worksheets("Données").Range(Worksheets("Données").Cells(1, 1), Worksheets("Données").Cells(DL2, 2))
    Set objChart = ThisWorkbook.Charts.Add
    objChart.ChartType = xlXYScatterLines
    objChart.SetSourceData objRange, xlColumns
    
    
With Sheets(1).Shapes
With .AddFormControl(x, 50, 50, 50, 50)
.Name = "Retour"
.OLEFormat.Object.Caption = "Retour"
.OLEFormat.Object.OnAction = "BOUTON"
With .OLEFormat.Object.Font
.Name = "Arial"
.Bold = True
.ColorIndex = 3
End With
End With
End With
    
End Sub


Et elle ne marche pas.......... Quelqu'un a une explication?

Propriété ou méthode non gérée par cet objet sur :

With .OLEFormat.Object.Font


Mais je répète, la macro si je l'exécute toute seule m'ajoute un joli bouton sans poser de question.....

Merci de votre aide.
A voir également:

1 réponse

Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 61
13 oct. 2015 à 16:41
Je me répond tout seul, j'ai trouvé la solution. Mais alors je n'en reviens pas........

Sub AJOUTER_BOUTON()

With Sheets(1).Shapes
With .AddFormControl(x, 50, 50, 50, 50)
.Name = "Retour"
.OLEFormat.Object.Caption = "Retour"
.OLEFormat.Object.OnAction = "BOUTON"
With .OLEFormat.Object.Font
.Name = "Arial"
.Bold = True
.ColorIndex = 3
End With
End With
End With

End Sub


Sub BOUTON()

Application.DisplayAlerts = False

Sheets(1).Delete
Sheets("Données").Delete

Application.DisplayAlerts = True

End Sub


Sub Code()

Dim DL As Long, DL2 As Long, Début As String, Fin As String, Produit As String, DC As Long, objChart As Chart, objRange As Range, MaSerie As Series, Obj As Object, Code As String

Produit = InputBox("Entrer le nom du produit à analyser")

If Produit = "" Then Exit Sub

Début = InputBox("Entrer le numéro de la première semaine à analyser <sans le S, (exemple 1, 12)>")

If Début = "" Then Exit Sub

Fin = InputBox("Entrer le numéro de la dernière semaine à analyser <sans le S, (exemple 1, 12)>")

If Fin = "" Then Exit Sub

Set FEUILLE_GRAPH = Sheets.Add
FEUILLE_GRAPH.Name = "Données"

DL = Sheets("Base").Cells(Application.Rows.Count, 1).End(xlUp).Row 'Si la colonne 1 est bien remplie jusqu'à la fin du tableau

DC = Sheets("Base").Cells(1, Application.Columns.Count).End(xlToLeft).Column 'si la ligne 1 est bien remplie jusqu'à la fin du tableau

For i = 2 To DL 'Si produits vont de la ligne 2 à la ligne xxx
For j = 2 To DC 'Les les semaines vont de la colonne 2 à la ligne xxx

If Sheets("Base").Range("A" & i).Value = Produit Then
    If Right(Sheets("Base").Cells(1, j), 2) >= Val(Début) Then
        If Right(Sheets("Base").Cells(1, j), 2) <= Val(Fin) Then
            Valeurs = Valeurs & "Résultats pour la SEMAINE " & Right(Sheets("Base").Cells(1, j), 2) & ":           " & Sheets("Base").Cells(i, j).Value * 100 & "%" & vbLf
            x = x + 1
            Sheets("Données").Cells(x, 1) = Right(Sheets("Base").Cells(1, j), 2)
            Sheets("Base").Cells(i, j).Copy Sheets("Données").Cells(x, 2)
        End If
    End If
End If

Next j
Next i

DL2 = Sheets("Données").Cells(Application.Rows.Count, 1).End(xlUp).Row

Sheets("Données").Columns("A:B").Sort Key1:=Range("A1")

Set objRange = Worksheets("Données").Range(Worksheets("Données").Cells(1, 1), Worksheets("Données").Cells(DL2, 2))
    Set objChart = ThisWorkbook.Charts.Add
    objChart.ChartType = xlXYScatterLines
    objChart.SetSourceData objRange, xlColumns
    
    
Call AJOUTER_BOUTON
    
End Sub


Je suis obligé de le Call....
0