Interprétation Code pour VBA barre bouton coloriage
Bonjour,
J'ai récupéré un code mais que je n'arrive pas à faire fonctionner dans mon fichier.
J'ai erreur de compilation : fonction ou variable attendue.
Ci-après le code et en pj le fichier.
Je prends bien soin de créer une zone de Nom nommée "Couleurs" et une feuille nommée couleurs.
Dans un module
Dim Barre As CommandBar
Sub AfficheMenu()
On Error Resume Next
CommandBars("BarreColoriage").Delete
On Error GoTo 0
ReDim ListeShapes(1 To Sheets("couleurs").Shapes.Count)
i = 1
For Each s In Sheets("couleurs").Shapes
ListeShapes(i) = s.Name: i = i + 1
Next s
Set Barre = Application.CommandBars.Add("barreColoriage", msoBarPopup)
'à mon avis l'erreur vient d'ici
For b = 1 To UBound(ListeShapes)
Sheets("couleurs").Shapes(ListeShapes(b)).Copy
texte = Sheets("couleurs").Shapes(ListeShapes(b)).DrawingObject.Caption
With Barre.Controls.Add(msoControlButton, 1, ListeShapes(b), , True)
.PasteFace
.Caption = Sheets("couleurs").Shapes(ListeShapes(b)).DrawingObject.Caption
.OnAction = "Coloriage(" & b & ")"
End With
Next b
Barre.ShowPopup
End Sub
Sub Coloriage(p)
Application.ScreenUpdating = False
couleur = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).Fill.ForeColor
texte = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).DrawingObject.Caption
If texte = "efface" Then texte = ""
Selection.Interior.Color = couleur
Selection.Value = texte
End Sub
J'ai réussi à le faire fonctionner dans le fichier joint mais l'affichage est très lent.
Avez-vous des idées pour rendre l'affichage instantanné (clic sur le planning ).
Merci
Bonjour,
J'ai récupéré un code mais que je n'arrive pas à faire fonctionner dans mon fichier.
J'ai erreur de compilation : fonction ou variable attendue.
Ci-après le code et en pj le fichier.
Je prends bien soin de créer une zone de Nom nommée "Couleurs" et une feuille nommée couleurs.
Dans un module
Dim Barre As CommandBar
Sub AfficheMenu()
On Error Resume Next
CommandBars("BarreColoriage").Delete
On Error GoTo 0
ReDim ListeShapes(1 To Sheets("couleurs").Shapes.Count)
i = 1
For Each s In Sheets("couleurs").Shapes
ListeShapes(i) = s.Name: i = i + 1
Next s
Set Barre = Application.CommandBars.Add("barreColoriage", msoBarPopup)
'à mon avis l'erreur vient d'ici
For b = 1 To UBound(ListeShapes)
Sheets("couleurs").Shapes(ListeShapes(b)).Copy
texte = Sheets("couleurs").Shapes(ListeShapes(b)).DrawingObject.Caption
With Barre.Controls.Add(msoControlButton, 1, ListeShapes(b), , True)
.PasteFace
.Caption = Sheets("couleurs").Shapes(ListeShapes(b)).DrawingObject.Caption
.OnAction = "Coloriage(" & b & ")"
End With
Next b
Barre.ShowPopup
End Sub
Sub Coloriage(p)
Application.ScreenUpdating = False
couleur = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).Fill.ForeColor
texte = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).DrawingObject.Caption
If texte = "efface" Then texte = ""
Selection.Interior.Color = couleur
Selection.Value = texte
End Sub
Bonsoir,
supprime le Application.Screenupdating (dans Worksheet_SelectionChange)
A+
Je n'ai pas d'erreur quand je déplace ces feuilles sur le fichier que tu as joint.
Il faudrait expliquer comment (et ou) tu les déplaces et joindre un imprim écran du message d'erreur et de la macro en cause ainsi éventuellement que la ligne de code surlignée.
A+
Bonsoir,
Désolé de répondre tardivement. J'ai réussi à détecter l'origine du problème: j'avais dans mon classeur deux macros avec le même nom.
Maintenant j'ai un autre souci. j'ai bien le menu coloriage qui sort mais quand je sélectionne une tâche, elle ne s'écrit pas dans la cellule.
Le problème viendrait donc de la macro :
Sub Coloriage(p)
Application.ScreenUpdating = False
couleur = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).Fill.ForeColor
texte = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).DrawingObject.Caption
If texte = "efface" Then texte = ""
Selection.Interior.Color = couleur
Selection.Value = texte
End Sub
Merci
Je n'ai pas d'erreur quand je déplace ces feuilles sur le fichier que tu as joint.
Il faudrait expliquer comment (et ou) tu les déplaces et joindre un imprim écran du message d'erreur et de la macro en cause ainsi éventuellement que la ligne de code surlignée.
A+
J'ai aussi selon la cellule où je clique des couleurs différentes pour une même tâche.
Avez-vous svp une idée ?
Bonsoir,
Désolé de répondre tardivement. J'ai réussi à détecter l'origine du problème: j'avais dans mon classeur deux macros avec le même nom.
Maintenant j'ai un autre souci. j'ai bien le menu coloriage qui sort mais quand je sélectionne une tâche, elle ne s'écrit pas dans la cellule.
Le problème viendrait donc de la macro :
Sub Coloriage(p)
Application.ScreenUpdating = False
couleur = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).Fill.ForeColor
texte = Sheets("couleurs").Shapes(Barre.Controls(p).Parameter).DrawingObject.Caption
If texte = "efface" Then texte = ""
Selection.Interior.Color = couleur
Selection.Value = texte
End Sub
Merci
Je n'ai pas d'erreur quand je déplace ces feuilles sur le fichier que tu as joint.
Il faudrait expliquer comment (et ou) tu les déplaces et joindre un imprim écran du message d'erreur et de la macro en cause ainsi éventuellement que la ligne de code surlignée.
A+
Bonjour,
Evite d'utiliser la balise citation ( ) à tort et à travers
par contre tu devrais utiliser la balise ( </> ) plus souvent (en particulier quand tu cites du code)
Enfin pose des questions explicites :
J'ai un problème
ça ne marche pas
selon la cellule où je clique j'ai des couleurs différentes pour une même tâche
... Ne sont pas des questions
De plus TOUSSA est terriblement imprécis :
J'ai un problème : Ah oui lequel ?
ça ne marche pas : Ah bon, Alors que de passe-t-il ? Ya-t-il un message d'erreur, si oui lequel ?
selon la cellule où je clique : Et quelles sont les cellules et le résultat ?
Et à chaque fois tu joint le fichier (et pas une image) au moment ou tu as repéré l'erreur.
A+