XL 2016 Menu Contextuel Clic droit

[Merlin258413]

Bonjour
j'ai besoin de votre aide concernant cette macro que j'ai trouvé sur le site
J'utilise dans ma fonction très souvent les fonctions valeurs cibles et atteindre
Je désire les intégrer dans un menu contextuel clic droit

J'ai trouvé ce fichier savez vous comment je peux l'adaptater et remplacer bleu et rouge par mes fonctions

1- Atteindre
Sub Atteindre()
Selection.SpecialCells(xlCellTypeVisible).Select
End Sub

et
2- Valeur cible
Faire appel à valeur cible

EN vous remerciant pour votre aide

Excellente journée

 

[apnart]

Bonjour Merlin.

Dans le Module1 de ton excel, tu as ça, et je pense que tu l'as vu, ce sont les macros standards qui changent les couleurs :

Sub Rouge()
    ActiveCell.Interior.ColorIndex = 3
End Sub
Sub Bleu()
    ActiveCell.Interior.ColorIndex = 5
End Sub
Sub Efface()
    ActiveCell.Interior.ColorIndex = xlNone
End Sub

Mais si tu regarde aussi dans "ThisWorkbook", tu as ça, c'est ce qui appelle tes macros ci-dessus (OnAction) :

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("Cell").Reset
End Sub

Private Sub Workbook_Open()
Application.CommandBars("Cell").Reset
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Rouge"
    .BeginGroup = True
    .OnAction = "Rouge"
End With
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Bleu"
    .OnAction = "Bleu"
End With
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Efface"
    .OnAction = "Efface"
End With
End Sub

;-)

 

[Merlin258413]

Bonjour apnart, je vais essayer savez vous quel la macro qui appelle la fonction valeur cible ? et je veux généraliser cette macro sur tous mes fichiers Excel si je l'enregistre dans PERSONAL cela ne suffira pas ?
cordialement

 

[apnart]

Dans module 1, il y a par exemple :

Sub Rouge()
    ActiveCell.Interior.ColorIndex = 3
End Sub

C'est ce qui colorie la cellule en rouge

Dans ThisWorkbook il y a :

Application.CommandBars("Cell").Reset
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Rouge"
    .BeginGroup = True
    .OnAction = "Rouge"
End With

c'est ce qui appelle la macro
- Caption : ce qui est affiché dans le clic droit (Rouge)
- BeginGroup = True : c'est pour mettre un séparateur avant (le trait au dessus)
- OnAction = "Rouge" : "Rouge" étant le nom de la macro concernée

 

[Merlin258413]

Dans module 1, il y a par exemple :

Sub Rouge()
    ActiveCell.Interior.ColorIndex = 3
End Sub

C'est ce qui colorie la cellule en rouge

Dans ThisWorkbook il y a :

Application.CommandBars("Cell").Reset
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Rouge"
    .BeginGroup = True
    .OnAction = "Rouge"
End With

c'est ce qui appelle la macro
- Caption : ce qui est affiché dans le clic droit (Rouge)
- BeginGroup = True : c'est pour mettre un séparateur avant (le trait au dessus)
- OnAction = "Rouge" : "Rouge" étant le nom de la macro concernée

Merci pour cette partie cela va mais
Savez vous quel la macro qui appelle la fonction valeur cible ?
Je veux généraliser cette macro sur tous mes fichiers Excel comment faire ?
En vous remerciant pour votre aide

 

[patricktoulon]

re
bonjour
bon ben on s'amuse avec les popup allons y
perso quand j'ai plusieurs boutons qui font la meme chose je les met dans un sous menu ton menu couleur
perso quand j'ai des boutons perso dans les menu je les met en premiers
tu veux faire pareil que l'exemple couleur pour tes menu perso a toi
allons y je t'en rajoute 1 même
je t'ai meme laisser le menu couleur

alors si tu veux bien on va faire les choses proprement
tout ce qui est construction ou destruction du menu doit etre dans un standard
dans le thisworkbook (open/close) il ne doit y avoir que les apels de macros


bon!!
dans le this workbook tu va mettre ceci
c'est pas compliqué c'est les appels

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
resetBar
End Sub

Private Sub Workbook_Open()
barre
End Sub

dans un module standard tu va mettre cela
il te restera a coder la sub valcible

Option Explicit
Sub resetBar(): Application.CommandBars("Cell").Reset: End Sub
Sub barre()
   Dim c, Nc, i&
    resetBar
    With Application.CommandBars("Cell").Controls.Add(msoControlPopup, , , 1)
        .Caption = "Couleurs"
        c = Array(xlNone, 3, 4, 5, 6)    'index couleur
        Nc = Array("Aucune couleur", "Rouge", "Vert", "Bleu", "jaune")    ' caption
        For i = 0 To UBound(c)
            With .Controls.Add(msoControlButton)
                .Caption = Nc(i): .OnAction = "couleur"
                .Tag = c(i)
                With Cells(Rows.Count, Columns.Count): .Interior.ColorIndex = c(i): .CopyPicture: End With
                .PasteFace
            End With
        Next
    End With
    With Application.CommandBars("Cell").Controls.Add(msoControlPopup, , , 2)
        .Caption = "Menu Atteindre"
        With .Controls.Add(msoControlButton): .Caption = "selection des visibles": .OnAction = "Atteindre": End With
        With .Controls.Add(msoControlButton): .Caption = "copier  la partie visible": .OnAction = "CopierVisible": End With
        With .Controls.Add(msoControlButton): .Caption = "Valeur cible": .OnAction = "valcible": End With
    End With
    Cells(Rows.Count, Columns.Count).Interior.ColorIndex = xlNone
End Sub

Sub couleur()
    ActiveCell.Interior.ColorIndex = CommandBars.ActionControl.Tag
End Sub


Sub Atteindre(): Selection.SpecialCells(xlCellTypeVisible).Select: End Sub
Sub CopierVisible(): Selection.SpecialCells(xlCellTypeVisible).Copy: End Sub

Sub valcible()

End Sub

et voila

 

[Merlin258413]

Bonjour je pense que je dois reformuler cette demande je ne veux pas que cette macro soit utilisée uniquement pour un fichier Excel mais pour tous les fichiers Excel que je pourrais utiliser à l'avenir Au même titre que Copier coller ,supprimer.

Je désire dans ce menu et pour tous mes fichers Excel ouverts la possibilité d'avoir
1- La fonction atteindre cellules visibles seulement : Selection.SpecialCells(xlCellTypeVisible).Select
2- La fonction Valeur Cible, sans valeur à atteindre cellule à modifier et sans calcul généré

En vous remerciant à tous pour votre aide

 

[patricktoulon]

re

dans ces cas c'est simple du crée la barre mais tu enlève le reset
tu peux même virer le code de création si tu veux après
maintenant si ton fichier doit Etre utilisé sur plusieurs pcs il faut garder la création moyennant un test d’existence de la barre
pour valeur cible je ne sais pas ou est ce dialog

cela dit si c'est des pc pro ça m’étonnerait que le boss laisse les employés faire ça il y a un web master ou une personne responsable park informatique pour ça

 

[Merlin258413]

Non c'est uniquement sur mon PC
Donc si je comprends bien, j' enregistre cette macro dans mon dossier personnel

1-

Option Explicit
Sub barre()
   Dim c, Nc, i&

    With Application.CommandBars("Cell").Controls.Add(msoControlPopup, , , 2)
        .Caption = "Menu Atteindre"
        With .Controls.Add(msoControlButton): .Caption = "selection des visibles": .OnAction = "Atteindre": End With
        With .Controls.Add(msoControlButton): .Caption = "Valeur cible": .OnAction = "valcible": End With
    End With
    Cells(Rows.Count, Columns.Count).Interior.ColorIndex = xlNone
End Sub

Sub Atteindre(): Selection.SpecialCells(xlCellTypeVisible).Select: End Sub
Sub valcible() :Application.CommandBars.FindControl(id:=856).Execute

End Sub

 

[Merlin258413]

Cela fonctionne parfaitement et merci à tous pour votre aide

Option Explicit
Sub barre()
    With Application.CommandBars("Cell").Controls.Add(msoControlPopup, , , 2)
      .Caption = "Menu"
        With .Controls.Add(msoControlButton): .Caption = "selection des visibles": .OnAction = "Atteindre": End With
        With .Controls.Add(msoControlButton): .Caption = "Valeur cible": .OnAction = "valcible": End With
    End With
    Cells(Rows.Count, Columns.Count).Interior.ColorIndex = xlNone
End Sub
Sub valcible(): Application.CommandBars.FindControl(id:=856).Execute

 

[Merlin258413]

Je me suis avancé trop vite cela fonctionne mais dès que je ferme Excel et je rouvre ce menu disparaît
je suis donc obligé de rajouter
Private Sub Workbook_Open()
barre
End Sub

 

[patricktoulon]

re
non!non! et non!
pour te la faire courte suprime l'evenement close de thisworkbook
tu verra tu l'aura dans tout tes fichier

 

[Staple1600]

Bonsoir le fil

Sinon, il y a aussi la QAT (qu'on peut personnaliser à loisirs) sans risque pour l'intégrité des CommandBars par défaut
(Pas besoin de macro, tout se pilote à la souris, et c'est utilisable sur tous les classeurs)

Et pour les cellules visibles, on a aussi
F5
ALT+C
ALT+L
OK

 

[Merlin258413]

Bonjour et merci pour votre remarque