[RÉSOLU] Existe -til une Macro pour affecter une macro à ce classeur

[un internaute]

Bonsoir le forum
Tout est dans le titre.
Merci pour d'éventuels retours
Bien cordialement

 

[Staple1600]

Bonjour le fil, le forum

@un internaute
En basant sur le titre (plus de détails dans le message aurait été en plus...)
Et en supputant un chouia, on peut stocker une macro dans le classeur de macros personnelles (Personal.xlsb), ce qui permet qu'elle soit disponible dans tous les classeurs.

Tu peux aussi créer un *.xla qui contiendra ta macro (il faudra ajouter une référence vers celui-ci dans VBE)

 

[un internaute]

Bonjour Ce lien n'existe plus et le forum
Je veux affecter le bouton dans le fichier joint aux 12 mois de l'année mais par une macro simple.
J'ai oublié de dire que j'ai 6 boutons par feuille, tous les même et de nombreux classeurs
Donc Clic droit nombreux
Bien cordialement à toi

 

[mapomme]

Bonjour @un internaute, @Staple1600 😉,

Une tentative pour affecter une macro du fichier aux formes dont l'intitulé commence par un texte donné.
Exécutez la macro contenu dans Module1:

Sub AffecterMacro()
'  Début de l'intitulé des formes auxquelles affecter la macro
Const DebutIntituleForme = "Afficher / Masquer"

'  Nom de la macro à affecter aux formes dont l'intitulé commence par DebutIntituleForme
'  -> mettre la chaine vide "" pour inhiber toute macro associée
Const MacroAaffecter = "AfficherMasquerDistanceMoisPrecedent"

Dim xf As Worksheet, xshp As Shape, Intit As String

   On Error Resume Next
   For Each xf In ThisWorkbook.Worksheets
      For Each xshp In xf.Shapes
         Intit = "": Intit = xshp.TextFrame2.TextRange.Characters.Text
         If Intit Like DebutIntituleForme & "*" Then xshp.OnAction = MacroAaffecter
      Next xshp
   Next xf
   On Error GoTo 0
   MsgBox "Traitement terminé.", vbInformation
End Sub

edit 9h20: joint la bonne version !!!

 

[Lone-wolf]

Bonjour aux ... troisinternautes 🙂😀

@mapomme: la macro n'est pas fonctionnel. Tu es sûr que les formes peuvent prendre la valeur OnAction?

 

[mapomme]

Bonjour @Lone-wolf 🙂😉,

C'est bizarre ! La macro fonctionne chez moi ! Je suis décontenancé 😱

 

[job75]

Bonjour à tous,

Avec la collection DrawingObjects c'est plus simple :

Sub Affecter()
Dim w As Worksheet, o As Object
For Each w In Worksheets
      For Each o In w.DrawingObjects
         If o.Text Like "Afficher / Masquer*" Then o.OnAction = "AfficherMasquerDistanceMoisPrecedent"
Next o, w
End Sub

A+

 

[mapomme]

Bonjour @job75 🙂,

Effectivement, ton code est plus simple.
Peux-tu me dire si la macro du fichier joint à mon premier message #4 fonctionne sur ton PC ?
Merci...

 

[job75]

Re,

Peux-tu me dire si la macro du fichier joint à mon premier message #4 fonctionne sur ton PC ?

Pas de problème chez moi, mais il faut savoir que TextFrame2 n'existe qu'à partir d'Excel 2013.

Edit : bah il paraît que c'est à partir d'Excel 2007 :

Ce lien n'existe plus

A+

 

[Lone-wolf]

Re

Bonjour job75 🙂

Une autre solution

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Ws As Worksheet

        If Sh.Name = "MENU" Then Exit Sub

        Application.ScreenUpdating = False
       
        For Each Ws In ThisWorkbook.Sheets
            With Ws
                .Unprotect
                .Rows("5:5").Hidden = IIf(.Rows("5:5").Hidden, False, True)
            End With
        Next Ws
Cancel = True
End Sub

 

[Lone-wolf]

Re

Je viens d'éffectuer un test avec la macro proposée par job75, c'est OK.

EDIT:
@mapomme: bizarre, maintenant ta macro fonctionne?! 😵

 

[mapomme]

Re,

@Lone-wolf : Vous avez dit bizarre ? Comme c'est bizarre ! Voir ici
@job75 :

Edit : bah il paraît que c'est à partir d'Excel 2007 :

Tu l'as dit juste avant moi

>En tout cas, bien que la version de job75 soit préférable puisqu’elle est concise et fonctionnelle, voici une modif de la version de mapomme qui devrait fonctionner aussi en Excel 2003. Cette version utilise OLEFormat.Object.Text qui devait exister en Excel 2003.

 

[Staple1600]

Bonjour le fil, le forum, un internaute, mapomme, job75, Lone-Wolf

Pour infos
1) la macro de job75 fonctionne sur Excel 2003
2) avec cette syntaxe la macro de ma pomme fonctionne sur Excel 2003
Intit = "": Intit = xshp.TextFrame.Characters.Text

Pour suggestion
On peut aussi écrire la macro des "boutons" comme ceci

Sub AfficherMasquerDistanceMoisPrecedent()
ActiveSheet.Unprotect
With ActiveSheet
.Rows("5:5").Hidden = Not .Rows("5:5").Hidden
End With
End Sub

 

[un internaute]

Bonjour Lone-wolf, job75, Ce lien n'existe plus

C'est la macro ci-dessous qui fonctionne NICKEL

Pourquoi ne pas mettre en entier? Afficher / Masquer Mois Précédent *remplace la 2ème ligne?

Sub Affecter()
Dim w As Worksheet, o As Object
For Each w In Worksheets
       For Each o In w.DrawingObjects
          If o.Text Like "Afficher / Masquer*" Then o.OnAction = "AfficherMasquerDistanceMoisPrecedent"
Next o, w
End Sub

Le code ci-dessous on le met où STP?

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

     Application.ScreenUpdating = False

     For Each Sh In ThisWorkbook.Sheets
         If Sh.Name = "MENU" Then Exit Sub
         With Sh
             .Unprotect
              .Rows("5:5").Hidden = IIf(.Rows("5:5").Hidden, False, True)
         End With
     Next Sh
     Cancel = True
End Sub

Merci à vous tous car un sacré soulagement pour ma toubib (tendinite!!!!)
Bon WE
Bien cordialement

 

[Staple1600]

Re

@un internaute
Tu as du zappé le message#13, non ? 😉
Notamment la simplication de AfficherMasquerDistanceMoisPrecedent

Bonjour Lone-wolf, job75, Ce lien n'existe plus

PS: J'ai pas le droit à un petit bonjour moi aussi???