Copie de code entre onglet via macro

[Résolu/Fermé]
Signaler
Messages postés
6
Date d'inscription
vendredi 22 juillet 2016
Statut
Membre
Dernière intervention
27 septembre 2016
-
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
-
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

Messages postés
7472
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
4 août 2021
646
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

Messages postés
6
Date d'inscription
vendredi 22 juillet 2016
Statut
Membre
Dernière intervention
27 septembre 2016

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 :)
Messages postés
7472
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
4 août 2021
646
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

Messages postés
6
Date d'inscription
vendredi 22 juillet 2016
Statut
Membre
Dernière intervention
27 septembre 2016

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"
Messages postés
7472
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
4 août 2021
646
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!
Messages postés
6
Date d'inscription
vendredi 22 juillet 2016
Statut
Membre
Dernière intervention
27 septembre 2016

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
Messages postés
7472
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
4 août 2021
646
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

Messages postés
6
Date d'inscription
vendredi 22 juillet 2016
Statut
Membre
Dernière intervention
27 septembre 2016

Parfait ça fonctionne.

Merci beaucoup Le Pivert :)
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 629
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.
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 629
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