Vider un module sans le supprimer, puis recréer du VBA dans ce module-là précisément

[EtienneChouard]

Bonjour le forum.

Je farfouille dans le forum depuis un moment pour éviter de vous embêter pour rien, mais décidément, je ne trouve pas ce qu'il me faut (je dois chercher comme une patate, sans doute : ma douce et tendre me le rappelle gentiment chaque fois que je l'oublie un peu )

Alors voici mon problème, si l'un des magiciens du coin veut bien m'aider :

Dans un planning, je voudrais assister la saisie en proposant des boutons, qui afficheraient chacun les initiales d'un des salariés pris dans une liste saisie à part, et chacun de ces boutons servirait à remplir automatiquement d'un clic les cellules de la sélection avec ces initiales.

Je suis donc en train de créer une barre d'outils paramétrée, c'est-à-dire dont les boutons (libellés et macros correspondantes) soient calculés/programmés pour correspondre à une table saisie dans une feuille : table des initiales des salariés.

J'ai trouvé comment créer la barre d'outils et les boutons, avec les bons libellés et avec le code VBA correspondant à chaque bouton, mais ça cloche encore (dans la boucle à la fin). Voici le code :

Sub CréerBarreDoutils()
    Dim Bouton As CommandBarButton
    
    Dim Ws As Worksheet
    Dim Obj As OLEObject
    Dim laMacro As String
    Dim x As Integer

    'On commence par détruire la barre d'outils si elle existe,
    'car on va la reconstruire de toutes pièces :
    On Error Resume Next
    Application.CommandBars("SaisiePlanning").Delete
    
    Set CmdBar = Application.CommandBars _
        .Add(Name:="SaisiePlanning", Position:=msoBarTop, _
        temporary:=True)
    
    Dim N, NOM, Cells
    N = 0
    NOM = ""
    Application.ScreenUpdating = False 'Fige l'écran
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 6678
        .OnAction = "EffacementCouleur"
        .TooltipText = "Effacement de la couleur"
        .Caption = "Efface Couleur"
        .Style = msoButtonIconAndCaption
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 6678
        .OnAction = "EffacementContenu"
        .TooltipText = "Effacement du contenu"
        .Caption = "Efface Contenu"
        .Style = msoButtonIconAndCaption
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 135
        .OnAction = "LIE"
        .TooltipText = "LIE"
        .Caption = "LIE"
        .Style = msoButtonIconAndCaption
        .Picture = stdole.StdFunctions.LoadPicture("C:\Mes documents\bouton_lie.gif")
    End With
    
    
        Set Bt = Application.CommandBars("Standard").Controls.Add(Type:=msoControlButton, before:=5, temporary:=True)
    
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 6851
        .OnAction = "VIN"
        .TooltipText = "VIN"
        .Caption = "VIN"
        .Style = msoButtonIconAndCaption
        .Picture = stdole.StdFunctions.LoadPicture("C:\Mes documents\bouton_vin.gif")
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 4
        .OnAction = "MARC"
        .TooltipText = "MARC"
        .Caption = "MARC"
        .Style = msoButtonIconAndCaption
        .Picture = stdole.StdFunctions.LoadPicture("C:\Mes documents\bouton_marc.gif")
    End With
    
    For Each Cells In Range("ListeDesInitiales")
        If Cells <> "" Then   'si la cellule n'est pas vide (contient des initiales), il faut créer un outil sur la barre d'outils
            N = N + 1
            NOM = Cells
             
             'création d'une macro pour chaque salarié : 
             ' macro dont LE NOM est le même que les initiales du salarié,
             'et dont le code VBA est fait pour insérer automatiquement les initiales en question 
             'dans toutes les cellules de la sélection :
             '(saisie assistée dans le planning)
             laMacro = "Sub " & NOM & "()" & vbCrLf
             laMacro = laMacro & "Dim Cells" & vbCrLf
             laMacro = laMacro & "Application.ScreenUpdating = False 'Fige l'écran" & vbCrLf
             laMacro = laMacro & "For Each Cells In Selection" & vbCrLf
             laMacro = laMacro & "Cells.value = " & """" & NOM & """" & vbCrLf
             laMacro = laMacro & "Next Cells" & vbCrLf
             laMacro = laMacro & "Application.ScreenUpdating = True" & vbCrLf
             laMacro = laMacro & "End Sub"
            
             With ThisWorkbook.VBProject.VBComponents(Sheets(5).CodeName).CodeModule
                 x = .CountOfLines + 1
                 .InsertLines x, laMacro
             End With
             
            'Si message "L’accès par programme au projet Visual Basic n’est pas fiable"
            'Alors Menu Outils d'Excel -> Macro -> Sécurité -> Onglets Sources fiables -> Cocher "Faire confiance au projet Visual Basic"
            'Pour atteindre le même menu sous Excel 2007 :
            'Menu Office -> Options Excel -> Centre de gestion de la confidentialité -> Paramètres du Centre de gestion de la confidentialité -> Paramètres des macros -> Accès approuvé au modèle d'objet du projet VBA
            
         End If
            
    Next Cells

    Application.ScreenUpdating = True

    CmdBar.Visible = True


End Sub

J'y suis presque, mais j'ai deux problèmes que je n'arrive pas à régler :

1) les macros en question (laMacro créée en boucle) ne fonctionnent pas parce que les boutons n'arrivent pas à les trouver (le code VBA crée les macros dans le code d'une feuille au lieu de les mettre dans le code d'un module).

Première question : comment imposer que le code créé soit placé dans le module1 (par exemple) et pas ailleurs ?



2) Le programme fonctionne la première fois, mais si on le fait tourner une deuxième fois, il crée des doublons, bien sûr... Il faudrait donc (au départ) supprimer toutes les anciennes procédures pour que la création puisse à nouveau avoir lieu au même endroit.

Deuxième question : comment vider un module (ce serait le module1 en l'occurrence) de toutes ses procédures sans détruire le module lui-même (puisqu'il va resservir aussitôt) ?


J'imagine que je vais me faire traiter de Cro-Magnon par les pros, mais j'assume Si vous avez des idées de code plus astucieux, ça m'intéresse au plus haut point, bien sûr.

Merci d'avance pour vos lumières et pour votre gentillesse.

Étienne.

 

[Papou-net]

Re : Vider un module sans le supprimer, puis recréer du VBA dans ce module-là précisé

Bonsoir Etienne,

Pour les lumières, tu as ouvert la bonne porte, mais pour la gentillesse, il y a des limites.

Sans te traiter de Cro-Magnon (tu le fais si bien toi-même) ni vouloir te froisser, comment veux-tu qu'un néophyte (de ton programme s'entend) puisse comprendre ce que tu recherches sans exemple à se mettre à l'écran ?

Si tu me permets un conseil, pourquoi vouloir créer, et supprimer peut-être, des boutons alors qu'une liste de choix avec cases-à-cocher serait bien plus facile à programmer ? Enfin ce n'est qu'une idée car sans support (je sais, je me répète mais Xld n'est pas la cour des miracles).

J'ose penser que tu interprèteras mes propos comme un simple exercice d'humour, et que tu feras tien l'adage : une simple image vaut mieux qu'un long discours.

Restant à ton écoute.

Cordialement.

 

[EtienneChouard]

Re : Vider un module sans le supprimer, puis recréer du VBA dans ce module-là précisé

Merci Papou-net

J'ai continué à chercher (pour vous éviter de la peine) et je crois que j'ai trouvé.

Le code suivant fonctionne :

Sub CréerBarreDoutils()
    Dim Bouton As CommandBarButton
    
    Dim Ws As Worksheet
    Dim Obj As OLEObject
    Dim laMacro As String
    Dim x As Integer

    'On commence par détruire la barre d'outils si elle existe,
    'car on va la reconstruire de toutes pièces :
    On Error Resume Next
    Application.CommandBars("SaisiePlanning").Delete
    
    Set CmdBar = Application.CommandBars _
        .Add(Name:="SaisiePlanning", Position:=msoBarTop, _
        temporary:=True)
    
    Dim N, NOM, Cells
    N = 0
    NOM = ""
    Application.ScreenUpdating = False 'Fige l'écran
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 6678
        .OnAction = "EffacementCouleur"
        .TooltipText = "Effacement de la couleur"
        .Caption = "Efface Couleur"
        .Style = msoButtonIconAndCaption
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 6678
        .OnAction = "EffacementContenu"
        .TooltipText = "Effacement du contenu"
        .Caption = "Efface Contenu"
        .Style = msoButtonIconAndCaption
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 135
        .OnAction = "LIE"
        .TooltipText = "LIE"
        .Caption = "LIE"
        .Style = msoButtonIconAndCaption
        .Picture = stdole.StdFunctions.LoadPicture("C:\Mes documents\bouton_lie.gif")
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 6851
        .OnAction = "VIN"
        .TooltipText = "VIN"
        .Caption = "VIN"
        .Style = msoButtonIconAndCaption
        .Picture = stdole.StdFunctions.LoadPicture("C:\Mes documents\bouton_vin.gif")
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 4
        .OnAction = "MARC"
        .TooltipText = "MARC"
        .Caption = "MARC"
        .Style = msoButtonIconAndCaption
        .Picture = stdole.StdFunctions.LoadPicture("C:\Mes documents\bouton_marc.gif")
    End With
    
    'Création des boutons INITIALES des salariés :
    
    'On commence par vider le Module1
    '(c'est lui qui sert à construire par programme les programmes des boutons) :
    With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
        .DeleteLines 1, .CountOfLines
    End With
    
    For Each Cells In Range("ListeDesInitiales")
        If Cells <> "" Then     'si la cellule n'est pas vide (contient des initiales),
                                'il faut créer un outil sur la barre d'outils
            N = N + 1
            NOM = Cells
             
             'création d'une macro pour chaque salarié :
             'macro dont LE NOM est le même que les initiales du salarié,
             'et dont le code VBA est fait pour insérer automatiquement les initiales en question
             'dans toutes les cellules de la sélection :
             '(saisie assistée dans le planning)
             laMacro = "Public Sub " & NOM & "()" & vbCrLf
             laMacro = laMacro & "Dim Cells" & vbCrLf
             laMacro = laMacro & "Application.ScreenUpdating = False 'Fige l'écran" & vbCrLf
             laMacro = laMacro & "For Each Cells In Selection" & vbCrLf
             laMacro = laMacro & "Cells.value = " & """" & NOM & """" & vbCrLf
             laMacro = laMacro & "Next Cells" & vbCrLf
             laMacro = laMacro & "Application.ScreenUpdating = True" & vbCrLf
             laMacro = laMacro & "End Sub"
            
             With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
                 x = .CountOfLines + 1
                 .InsertLines x, laMacro
             End With
             
            '"L’accès par programme au projet Visual Basic n’est pas fiable"
            'Menu Outils d'Excel -> Macro -> Sécurité -> Onglets Sources fiables
            '-> Cocher "Faire confiance au projet Visual Basic"
            'Pour atteindre le même menu sous Excel 2007 :
            'Menu Office -> Options Excel -> Centre de gestion de la confidentialité
            '-> Paramètres du Centre de gestion de la confidentialité
            '-> Paramètres des macros -> Accèes approuvé au modèle d'objet du projet VBA
            
            Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
            With Bouton
                .OnAction = NOM
                .TooltipText = NOM
                .Caption = NOM
                .Style = msoButtonIconAndCaption
            End With
            
         End If
            
    Next Cells

    Application.ScreenUpdating = True

    CmdBar.Visible = True

End Sub

dans lequel la suppression de tout le code d'un module sans le détruire est obtenue ainsi :

     With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
        .DeleteLines 1, .CountOfLines
    End With

Attention : ce code (l'instruction .DeleteLines) ne fonctionne PAS en mode pas-à-pas sans afficher un message d'erreur :

Impossible d'entrer en Mode Arrêt maintenant

mais en exécution normale, il fonctionne.On remarque la même chose pour la commande ci-dessous (.InsertLines).


Par ailleurs, l'affectation d'un code VBA à un module spécifique est facile puisqu'on peut mettre simplement le nom du module (entre guillemets) dans la propriété VBComponents :

             With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
                 x = .CountOfLines + 1
                 .InsertLines x, laMacro
             End With

Pardon pour le dérangement, et merci pour le temps consacré à me lire.

Signé Cro-Magnon

______________

PS : si vous avez des suggestions d'améliorations, je suis preneur.

Par exemple, on pourrait rêver d'une macro unique (à la place d'une macro par bouton), la même qui serait lancée par tous les boutons.

Mais cela suppose de savoir récupérer à partir d'une macro le nom du bouton qui l'a déclenchée.

Est-ce que vous savez faire ça ?

 

[Papou-net]

Re : Vider un module sans le supprimer, puis recréer du VBA dans ce module-là précisé

RE Étienne,

Par exemple, on pourrait rêver d'une macro unique (à la place d'une macro par bouton), la même qui serait lancée par tous les boutons.

Mais cela suppose de savoir récupérer à partir d'une macro le nom du bouton qui l'a déclenchée.

Est-ce que vous savez faire ça ?

Ce rêve existe, il s'appelle "Modules de classe".

Mais là encore, un fichier simplifié représentant la structure de ton classeur me paraît indispensable.

Sinon, tu peux rechercher des exposés ou des tutos sur la toile, mais autant te le dire tout de suite, ce n'est pas d'une approche évidente. Je les utilise depuis un certain temps et cela me demande toujours un gros effort de réflexion.

A +

Cordialement.

PS : je ne suis toutefois pas certain que l'on puisse appliquer ces modules à des barres d'outils. Mais on doit pouvoir simuler aisément une telle barre avec un UserForm et des boutons de commande.

 

[eriiic]

Re : Vider un module sans le supprimer, puis recréer du VBA dans ce module-là précisé

Bonjour à tous,

Mais cela suppose de savoir récupérer à partir d'une macro le nom du bouton qui l'a déclenchée.

Fonctionne pour des boutons sur feuille :
MsgBox Application.Caller
A tester pour tes boutons.

eric

 

[EtienneChouard]

Re : Vider un module sans le supprimer, puis recréer du VBA dans ce module-là précisé

Merci à tous les deux, bonne nuit