Copie de code entre onglet via macro

Résolu
no0ny -  
Bonjour,
Je vais développer un peu plus ici, le titre est pas vraiment clair et je vois pas trop comment l'exprimer plus facilement.
Pour les bases, je suis sur Excel 2007,
J'ai récupérer un classeur (AKA checklist quotidienne) j'ai automatisé la génération d'un classeur et une copie de la page principale en vidant certaines cellules.
Le problème, vu que c'est une checklist on à un Worksheet_BeforeDoubleClick qui permet de faire des jolies croix dans les cases (faut pas en demander à certaines personne :) ) .
Le problème c'est que j'aimerais le déplacer dans le nouvel classeur que je génère avec ma macro.
J'ai testé de le passer en Workbook_BeforeDoubleClick mais à chaque double clique ma page de code VBA plante et la fonction ne s'applique pas .

Je m'en remet donc à vous pour savoir comment je peux transmettre automatiquement ma fonction Worksheet_BeforeDoubleClick d'un classeur existant à un classeur que je créé via macro

9 réponses

  • Votes
  • Date
  • Date décroissante
  1. cs_Le Pivert Contributeur
    Bonjour,

    comme ceci: 

    Option Explicit
Private Sub CommandButton1_Click()
Dim LeClasseurCible As Workbook
Set LeClasseurCible = Workbooks("Classeur1.xls") 'le classeur doit être ouvert adapter le nom
TransfertModule LeClasseurCible
End Sub
Sub TransfertModule(wkb As Workbook)
    Dim moduleTexte As String
    With ThisWorkbook.VBProject.VBComponents("Feuil1").CodeModule 'adapter nom de la Feuille
        moduleTexte = .Lines(1, .CountOfLines)
    End With
    moduleTexte = Replace(moduleTexte, "Option Explicit", "")
    wkb.VBProject.VBComponents("Feuil1").CodeModule.AddFromString moduleTexte 'adapter nom de la Feuille
End Sub

    1. no0ny Auteur
      Merci,
      très pratique la fonction mais ne passe pas pour mon cas.
      J'ai un onglet Semaine 30 qui génère Semaine 31
      Et il me faut un moyen de copier mon code Worksheet_BeforeDoubleClick de la semaine 30 à la semaine 31.

      Je sais pas si c'est super clair, mais on fait notre maximum :)
      1. cs_Le Pivert Contributeur
        sans code, difficile de répondre!

        peut-être en renseignant les feuilles comme ceci: 

        Sub TransfertModule(wkb As Workbook)
    Dim moduleTexte As String
    With ThisWorkbook.VBProject.VBComponents("semaine30").CodeModule 'adapter nom de la Feuille
        moduleTexte = .Lines(1, .CountOfLines)
    End With
    moduleTexte = Replace(moduleTexte, "Option Explicit", "")
    wkb.VBProject.VBComponents("semaine31").CodeModule.AddFromString moduleTexte 'adapter nom de la Feuille
End Sub

        1.  no0ny Auteur
          En code j'en ai pas, je test les fonctions depuis un bouton
          Quand je test avec ton morceaux de code il me sort une erreur 424 Objet requis

          C'est sur cette ligne ci
          wkb.VBProject.VBComponents("semaine31").CodeModule.AddFromString moduleTexte

          J'ai refixé le nom dans l'explorateur de projet VBA en "semaine31"
          2. cs_Le Pivert Contributeur
            en lisant ceci, il y a bien une macro!

            Le problème c'est que j'aimerais le déplacer dans le nouvel classeur que je génère avec ma macro.

            Ce n'est pas clair du tout!

            Il faut que dans le classeur créé, il y est des feuilles nommées semaine30 et semaine31. Sinon cela ne peut fonctionner. Ce que je voudrais c'est la macro qui crée ce classeur!
            1. no0ny Auteur 
              Sub crea()
Dim semaine As Byte  'creation d'une variable semaine pour le numéro de semaine
semaine = WorksheetFunction.WeekNum(Date, 21) + 1 'Récupération du Numero de semaine
Sheets.Add  'création d'un onglet
ActiveSheet.Name = "semaine" & semaine 'Renommage de l'onglet avec le numéro de la semaine "Semaine X"
End Sub


              Voila ce code pour faire mon onglet avec mon nom de semaine
              1. cs_Le Pivert Contributeur
                Avec le code c'est quand même plus facile! 

                Dim semaine As Byte  'creation d'une variable semaine pour le numéro de semaine
Sub crea()
semaine = WorksheetFunction.WeekNum(Date, 21) + 1 'Récupération du Numero de semaine
Sheets.Add  'création d'un onglet
ActiveSheet.Name = "semaine" & semaine 'Renommage de l'onglet avec le numéro de la semaine "Semaine X"
End Sub
Sub TransfertModule(wkb As Workbook)
    Dim moduleTexte As String
    With ThisWorkbook.VBProject.VBComponents("semaine" & semaine).CodeModule 'adapter nom de la Feuille
        moduleTexte = .Lines(1, .CountOfLines)
    End With
    moduleTexte = Replace(moduleTexte, "Option Explicit", "")
    wkb.VBProject.VBComponents("semaine" & semaine).CodeModule.AddFromString moduleTexte 'adapter nom de la Feuille
End Sub

                2.  pijaku Modérateur
                  Bonjour,

                  Il est possible de s'affranchir de tout ceci (écrire un module de code par feuille), en passant par 2 modules de classe, 1 nom (gestionnaire de noms), 1 module standard et le module ThisWorkbook.
                  Par contre, cela nécessitera de supprimer tous les modules objets des feuilles déjà créées...
                  Si vous êtes intéressés, n'hésitez pas à relancer ce sujet.
                  1. pijaku Modérateur
                    Je mets ce code à titre d'exemple uniquement :

                    !!! A placer dans un nouveau classeur !!!

                    dans un module standard : 
                    Public Classe As New ClApplication
Public SheetsColl() As New ClFeuille
Public Index As Long

Public Sub Init()
    Dim monString As String, F As Variant, E As Variant, Sh As Worksheet
    Set Classe.App = Application
    monString = Replace(ThisWorkbook.Names("Feuilles_Classe").RefersTo, "=", "")
    F = Split(monString, ",")
    If UBound(F) = 0 Then Exit Sub
    For Each E In F
        Set Sh = Sheets(E)
        SheetsAdd Sh
    Next E
End Sub

Public Sub SheetsAdd(Wsh As Worksheet)
    Index = Index + 1
    ReDim Preserve SheetsColl(Index)
    Set SheetsColl(Index).Feuille = Wsh
End Sub


                    Dans un module de classe nommé : ClApplication 
                    Option Explicit

Public WithEvents App As Application

Private Sub App_WorkbookNewSheet(ByVal Wb As Workbook, ByVal Sh As Object)
Dim strNom As String, E As Variant

    SheetsAdd Sh
    E = Split(ThisWorkbook.Names("Feuilles_Classe").RefersTo, ",")
    If UBound(E) = 0 Then
        strNom = Sh.Name
    Else
        strNom = ThisWorkbook.Names("Feuilles_Classe").RefersTo & "," & Sh.Name
    End If
    ThisWorkbook.Names("Feuilles_Classe").RefersTo = strNom
End Sub


                    Dans un module de classe nommé : ClFeuille 
                    Option Explicit

Public WithEvents Feuille As Worksheet

Private Sub Feuille_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'placer ici la procédure événementielle (valable pour chacune des feuilles)
    MsgBox Target.Address
End Sub


                    Dans le module ThisWorkbook : 
                    Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set Classe.App = Nothing
End Sub

Private Sub Workbook_Open()
Dim str As String
    On Error GoTo CreateNom
    str = ThisWorkbook.Names("Feuilles_Classe").RefersTo
    Init
    Exit Sub
CreateNom:
    ActiveWorkbook.Names.Add Name:="Feuilles_Classe", RefersTo:="="""""""""
    Init
End Sub


                    Ne reste qu'à définir le nom dans le gestionnaire de noms :
                    Onglet Formules
                    Gestionnaire de noms
                    Nouveau
                    >> Nom : Feuilles_Classe
                    >> RefersTo : Lister les feuilles séparées par un ; comme ceci :
                    Feuil1;Feuil3;Feuil4
                    Valider.

                    Fermer puis ouvrir le classeur