Insérer un bouton sur une feuille graphique
Résolu
Kuartz
Messages postés
852
Date d'inscription
Statut
Membre
Dernière intervention
-
Kuartz Messages postés 852 Date d'inscription Statut Membre Dernière intervention -
Kuartz Messages postés 852 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai trouvé une excellente macro qui insère sans problème un bouton sur une feuille graphique d'excel :
Seulement voilà, je l'intègre à ma macro principale :
Et elle ne marche pas.......... Quelqu'un a une explication?
Propriété ou méthode non gérée par cet objet sur :
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.
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:
- Insérer un bouton sur une feuille graphique
- Insérer une vidéo sur powerpoint - Guide
- Insérer une signature sur word - Guide
- Changer carte graphique - Guide
- Insérer liste déroulante excel - Guide
- Comment insérer des points de suite sur word - Guide
1 réponse
Je me répond tout seul, j'ai trouvé la solution. Mais alors je n'en reviens pas........
Je suis obligé de le Call....
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....