Affecter automatiquement une maccro Résolu

Question

bonjour,
j'ai une maccro qui permet créer une nouvelle feuille automatiquement lorsque je complete la cellule B1 :
------------------------------------------------------------------------------------
Sub Nouveau_Mois()
Application.ScreenUpdating = False
'confirmer sélection feuille / copier
Sheets("Base de données").Select
Cells.Select
Selection.Copy
'créer une nouvelle feuille / coller le type mois base
Sheets.Add after:=ActiveSheet
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 'nommer la feuille
    ActiveSheet.Name = Range("B1").Value
'ajouter dans le sommaire
Range("B1").Copy Destination:=Sheets("Sommaire").Range("B1").End(xlDown).Offset(1, 0)
'effacer le'entrée dans mois base de données
Sheets("Base de données").Activate
'retour au sommaire
Sheets("Sommaire").Select
Application.ScreenUpdating = True
End Sub
--------------------------------------
J'aurais aimé que quand cette maccro est executée, et donc qu'une nouvelle feuille est crée, elle soit codée par ca automatiquement (de la meme maniere que si j'avais fait onglet > visualiser le code > coller) : 
-------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target _
 As Range, Cancel As Boolean)
 If Not Intersect(Target, Range("a1")) Is Nothing Then
 Call Reset_C
 End If
 If Not Intersect(Target, Range("b1")) Is Nothing Then
 Call Reset_AF
 End If
 End Sub
----------------------------------
Merci à vous d'avance, LeoTaba.

LeoTaba · Answer

up ? c'est pour le taff ca m'ammuses pas non plus x)

LeoTaba · Answer

Je re-up

LeoTaba · Answer

Je re-up, encore

cs_Le Pivert · Answer

bonjour,
Les re-up et ce genre de post n'incite vraiment pas à te répondre.
Il faut te rappeler que nous sommes tous bénévoles!
https://forums.commentcamarche.net/forum/affich-34200040-creer-un-nouveau-fichier 
Je vais quand même te donner un code qu'il te faudra adapter:
'creer macro "retour Feuille1" dans la nouvelle feuille
Sub creer_macro()
Dim Code$, NextLine&
Sheets.Add.Move After:=Sheets(Sheets.Count) 'ajoute une feuille en dernier
On Error Resume Next
' Comment ajouter le code.
    Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf
    Code = Code & "If Not Application.Intersect(Target, Range(""H1"")) Is Nothing Then" & vbCrLf
    Code = Code & "Feuil1.Activate" & vbCrLf
    Code = Code & "End If" & vbCrLf
    Code = Code & "End Sub"
'   Ecriture du code dans le module de la feuille (fs)
With ActiveWorkbook.VBProject.VBComponents(Sheets(Sheets.Count).CodeName).CodeModule
       NextLine = .CountOfLines + 1
      .InsertLines NextLine, Code
End With
ActiveSheet.Range("H1").Value = "Retour" ' on saisi Retour dans la nouvelle feuille
End Sub

LéoTaba · Answer

Ouais j'sais bien mais si j'attends sans re-up le message sera moins visible et donc y a moins de chance qu'on me réponde. Bon j'essaie avec ton code, merci de ton aide je te tiens au courant cs_Le Pivert !

LéoTaba · Answer

Ok j'suis bien trop nul pour incrémenter ton code dans le mien je désespère

cs_Le Pivert · Answer

Quand je vois ce post, 
https://forums.commentcamarche.net/forum/affich-34368214-copier-des-formes
il faut suivre les conseils de Vaucluse que je salue. Voici un modèle de classeur qui t'évite de passer par la création d'une macro. quand tu copies ta feuille la macro est copiée aussi, ainsi que tout ce qui est présent sur ta feuille Modèle a adapter:
http://www.cjoint.com/c/GBripdXL1FQ

LéoTaba · Answer

Bon prenons le probleme autrement. Ce code la me semble tout a fait correspondre a ce que je veux :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("A1")) Is Nothing Then

    'macro à mettre (Reset_C pour mois)

    End If
End Sub
Ce code permet d'effectuer une maccro que j'ai créée (Reset_C) lorsqu'on clique sur la cellule A1.
Le problème c'est que je ne sais pas OU le rajouter dans le code qui gère la création d'une nouvelle feuille, j'pense pas que quand on s'y connaisse ce soit dur a intégrer alors si quelqu'un pouvait me le faire ca m'aiderait vraiment, c'est mon dernier soucis après 6semaines (entieres de 35h) a charbonner ce classeur excel.
Sub Nouveau_Mois()
Application.ScreenUpdating = False
'confirmer sélection feuille / copier
Sheets("Base de données").Select
Cells.Select
Selection.Copy
'créer une nouvelle feuille / coller le type mois base
Sheets.Add After:=ActiveSheet
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 'nommer la feuille
    ActiveSheet.Name = Range("B1").Value
'ajouter dans le sommaire
Range("B1").Copy Destination:=Sheets("Sommaire").Range("B1").End(xlDown).Offset(1, 0)

'effacer le'entrée dans mois base
Sheets("Base de données").Activate
Range("B1").ClearContents
Range("C5:an5").ClearContents
Range("C7:an7").ClearContents
Range("C9:an9").ClearContents
Range("C11:an11").ClearContents
Range("C13:an13").ClearContents
Range("C15:an15").ClearContents
Range("C17:an17").ClearContents
Range("C19:an19").ClearContents
Range("C21:an21").ClearContents
Range("C23:an23").ClearContents
Range("C25:an25").ClearContents
Range("C27:an27").ClearContents
Range("C29:an29").ClearContents
Range("C31:an31").ClearContents
Range("C33:an33").ClearContents
Range("C35:an35").ClearContents
Range("C37:an37").ClearContents
Range("C39:an39").ClearContents
Range("C41:an41").ClearContents
Range("C43:an43").ClearContents
Range("C45:an45").ClearContents
Range("C47:an47").ClearContents
Range("C49:an49").ClearContents
Range("C51:An51").ClearContents
Range("C53:An53").ClearContents
Range("C55:An55").ClearContents
Range("C57:An57").ClearContents
Range("C59:An59").ClearContents
Range("C61:An61").ClearContents
Range("C63:An63").ClearContents
Range("C65:An65").ClearContents
Range("C67:An67").ClearContents
Range("C69:an69").ClearContents
Range("C71:an71").ClearContents
Range("C73:an73").ClearContents
Range("C75:an75").ClearContents
Range("C77:An77").ClearContents
Range("C79:An79").ClearContents
Range("C81:An81").ClearContents
Range("C83:An83").ClearContents
Range("C85:An87").ClearContents
Range("C89:An91").ClearContents
Range("C93:An94").ClearContents
Range("C96:an99").ClearContents
Range("C101:an101").ClearContents
Range("C103:an103").ClearContents
Range("C105:An105").ClearContents
Range("C107:An107").ClearContents
Range("C109:An110").ClearContents
Range("C112:An114").ClearContents
Range("C115:G118").ClearContents
Range("j115:n118").ClearContents
Range("q115:u118").ClearContents
Range("x115:ab118").ClearContents
Range("ae115:ai118").ClearContents
Range("al115:an118").ClearContents
Range("C119:AN139").ClearContents
Range("C141:An143").ClearContents
Range("C119:An125").ClearContents
Range("C145:An148").ClearContents
Range("C150:An166").ClearContents
Range("C174:AN176").ClearContents
'retour au sommaire
Sheets("Sommaire").Select
Application.ScreenUpdating = True
End Sub
En gros ce code permet de créer une nouvelle feuille X basée sur une autre feuille Y (ca fait un copié-collé), effacer le contenu des cellules de l'ancienne feuille Y, et ajouter le nom de cette feuille X au sommaire. Mais dans la nouvelle feuille X créée, il me FAUT la maccro permettant de Reset_C quand on clique sur A1 (ou double clique je sais plus).
Il ne faut pas avoir a rajouter le code a chaque fois dans la nouvelle feuille X, il faudrait que ca se fasse AUTOMATIQUEMENT.
Ce code m'a été donné par Vaucluse, un membre qui m'a permi de garder mes cheveux 10ans de plus ;)
Merci a celui qui pourra m'aider, 
cordialement, je-ne-peux-pas-signer-car-c'est-bloqué-par-le-filtre-anti-language-sms

cs_Le Pivert · Answer

Tu n'as pas besoin de recréer un code dans les  feuilles ajoutées. Le code est solidaire de la feuille ainsi que toutes les données lors de la copie. Je te l'ai déjà dit!
Voici un autre exemple plus compréhensible en prenant  ton exemple:
http://www.cjoint.com/c/GBvpqBVysnQ

LéoTaba · Answer

Bah je suis désolé mais j'ai beau lire de long en large les codes, je comprends pas comment tu as fait pour que le code 
Option ExplicitPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Not Intersect(Target, Range("A1")) Is Nothing Then Reset_CEnd IfIf Not Intersect(Target, Range("B1")) Is Nothing ThenReset_AFEnd IfEnd Sub
s'implente automatiquement dans toutes les feuilles que l'ont crée.
Pourrais tu m'expliquer ? Ou as tu écrit ce code a la base pour qu'il s'inscrive sur les feuilles que l'ont crée ?
Merci, je-ne-peux-pas-signer-car-c'est-bloqué-par-le-filtre-anti-language-sms

LéoTaba · Answer

Ha mais parce que toi ton code n'est pas un module et que tu copie carrément la feuille Bdd. Tandis que moi, je copie les CELLULES de la Bdd. Du coup je suis obligé de tout refaire et utiliser tes codes ? Ou c'est possible de les adapter ?

LéoTaba · Answer

Parce que la copie des cellules de la base de donnée est régie par le fait qu'on selectionne DANS la cellule B1 de la BDD une date (exzemple mai2011) et si je copie la BDD elle même plutôt que les cellules, bah les nouvelles feuilles pourront elles memes créeer d'autres feuilles si on met qq chose dans leur cellule B1. 
Et ca pourrait être désastreux dans les mains des personnes que je cotoie.
Cdlmt.

cs_Le Pivert · Answer

voilà ton code:
Sub creer_macro()
Dim Code$, NextLine&
Sheets.Add.Move After:=Sheets(Sheets.Count) 'ajoute une feuille en dernier
On Error Resume Next
' Comment ajouter le code.
    Code = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" & vbCrLf
    Code = Code & "If Not Intersect(Target, Range(""a1"")) Is Nothing Then" & vbCrLf
    Code = Code & "Call Reset_C" & vbCrLf
    Code = Code & "End If" & vbCrLf
   Code = Code & "If Not Intersect(Target, Range(""b1"")) Is Nothing Then" & vbCrLf
    Code = Code & "Call Reset_AF" & vbCrLf
    Code = Code & "End If" & vbCrLf
    Code = Code & "End Sub"
'   Ecriture du code dans le module de la feuille (fs)
With ActiveWorkbook.VBProject.VBComponents(Sheets(Sheets.Count).CodeName).CodeModule
       NextLine = .CountOfLines + 1
      .InsertLines NextLine, Code
End With
End Sub

LéoTaba · Answer

Ok et ce code la il va sur ma feuille BDD ? ou sur le sommaire ? ou bien c'est un module ... :x ?

LéoTaba · Answer

Peut etre que si vous pouvez acceder au fichier, ce sera plus simple (je suis un peu neuneu) : http://www.cjoint.com/c/GBxgRxKC0NU
Le plus simple c'est de faire comme je voulais, 
ou bien serait il préférable de :
1- Adapter le code de la BDD pour le mettre sur la page sommaire, qui aurait donc 2 codes : -un pour un renvoie par double clic (colonne A) -un pour lancer la création d'une feuille (copie de la BDD)
2-Coder la BDD avec les maccro Reset (les codes dont je parlais au tout début)
3-Changer le module de création de feuilles (Nouveau_Mois) pour copier coller la BDD (comme votre fichier) plutôt que de copier les cellules.
Merci u_u

cs_Le Pivert · Answer

Voilà le nouveau code à changer, c'est tout
Sub Nouveau_Mois()
Dim Code$, NextLine&
Application.ScreenUpdating = False
'confirmer sélection feuille / copier
Sheets("Base de données").Select
Cells.Select
Selection.Copy
'créer une nouvelle feuille / coller le type mois base
Sheets.Add After:=ActiveSheet
On Error Resume Next
' Comment ajouter le code.
    Code = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" & vbCrLf
    Code = Code & "If Not Intersect(Target, Range(""a1"")) Is Nothing Then" & vbCrLf
    Code = Code & "Call Reset_C" & vbCrLf
    Code = Code & "End If" & vbCrLf
   Code = Code & "If Not Intersect(Target, Range(""b1"")) Is Nothing Then" & vbCrLf
    Code = Code & "Call Reset_AF" & vbCrLf
    Code = Code & "End If" & vbCrLf
    Code = Code & "End Sub"
'   Ecriture du code dans le module de la feuille (fs)
With ActiveWorkbook.VBProject.VBComponents(Sheets(Sheets.Count).CodeName).CodeModule
       NextLine = .CountOfLines + 1
      .InsertLines NextLine, Code
End With
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False

'nommer la feuille
 
    ActiveSheet.Name = Range("B1").Value
    
'ajouter dans le sommaire

Range("B1").Copy Destination:=Sheets("Sommaire").Range("B1").End(xlDown).Offset(1, 0)

'effacer le'entrée dans mois base

Sheets("Base de données").Activate
Range("B1").ClearContents
Range("C5:an5").ClearContents
Range("C7:an7").ClearContents
Range("C9:an9").ClearContents
Range("C11:an11").ClearContents
Range("C13:an13").ClearContents
Range("C15:an15").ClearContents
Range("C17:an17").ClearContents
Range("C19:an19").ClearContents
Range("C21:an21").ClearContents
Range("C23:an23").ClearContents
Range("C25:an25").ClearContents
Range("C27:an27").ClearContents
Range("C29:an29").ClearContents
Range("C31:an31").ClearContents
Range("C33:an33").ClearContents
Range("C35:an35").ClearContents
Range("C37:an37").ClearContents
Range("C39:an39").ClearContents
Range("C41:an41").ClearContents
Range("C43:an43").ClearContents
Range("C45:an45").ClearContents
Range("C47:an47").ClearContents
Range("C49:an49").ClearContents
Range("C51:An51").ClearContents
Range("C53:An53").ClearContents
Range("C55:An55").ClearContents
Range("C57:An57").ClearContents
Range("C59:An59").ClearContents
Range("C61:An61").ClearContents
Range("C63:An63").ClearContents
Range("C65:An65").ClearContents
Range("C67:An67").ClearContents
Range("C69:an69").ClearContents
Range("C71:an71").ClearContents
Range("C73:an73").ClearContents
Range("C75:an75").ClearContents
Range("C77:An77").ClearContents
Range("C79:An79").ClearContents
Range("C81:An81").ClearContents
Range("C83:An85").ClearContents
Range("C87:An87").ClearContents
Range("C89:An90").ClearContents
Range("C92:An92").ClearContents
Range("C94:An94").ClearContents
Range("C96:AN96").ClearContents
Range("C98:An98").ClearContents
Range("C100:An101").ClearContents
Range("C103:an104").ClearContents
Range("C106:an108").ClearContents
Range("C110:An147").ClearContents
Range("C149:An151").ClearContents
Range("C153:An156").ClearContents
Range("C158:An173").ClearContents
Range("C180:AN184").ClearContents
'retour au sommaire
Sheets("Sommaire").Select
Application.ScreenUpdating = True
End Sub

LéoTaba · Answer

Mhh ton code semble pertinent mais pourtant quand une nouvelle feuille est crée, elle n'est pas codé par
    On Error Resume Next' Comment ajouter le codeCode = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" & vbCrLf    Code = Code & "If Not Intersect(Target, Range(""c1"")) Is Nothing Then" & vbCrLf    Code = Code & "Call Reset_C" & vbCrLf    Code = Code & "End If" & vbCrLf    Code = Code & "If Not Intersect(Target, Range(""d1"")) Is Nothing Then" & vbCrLf    Code = Code & "Call Reset_AF" & vbCrLf    Code = Code & "End If" & vbCrLf    Code = Code & "End Sub"
Et la maccro s'exécute sans poser de problèmes, donc j'en déduis que tu n'as pas fais de faute dans le code ... je ne vois pas d'où peut venir le probleme.
Tiens si tu veux jeter un coup d'œil (j'ai modif les cellule a1 et b1 par c1 et d1 (y a des trucs écrits en a1 et b1))
Peut être que ce n'est pas "Call Reset_C" que je devais mettre ? Ou peut être le "On Error Resume Next" ? Parce que si je l'enleve le fichier bloque a cette ligne With ActiveWorkbook.VBProject.VBComponents(Sheets(Sheets.Count).CodeName).CodeModule donc peut etre que le On Error Resume Next permet simplement de passer outre le probleme rencontré, et donc que le probleme vient de cette ligne.
Merci de tous tes efforts j'attends ta réponse impatiemment,
Leo
http://www.cjoint.com/c/GBxm1eiDrHl

cs_Le Pivert · Answer

N'inversons pas les rôles, pour l'instant c'est toi qu'il faut aider!
Personnellement je n'ai aucun problème avec mes macros!
Voilà une autre manière de faire, il faudra t'en contenter:
http://www.cjoint.com/c/GBxosXQ5qfQ
Bonne continuation

LéoTaba · Answer

Je pense que la façon la plus simple d'expliquer mon probleme c'est :
Quand je lance la maccro inscrite dans BASE DE DOINNEES
le module créer_mois se lance
Copie toutes les cellules de la base de données dans une nouvelle feuille, lui donne un nom, l'ajoute dans le sommaire, clean certaines cellules.
Ce qu'il me faudrait c'est que dans créer_mois, des lignes de codes insèrent dans les nouvelles feuilles créées le code permettant de lancer Reset_C.
Or votre solution en gros revient à copier juste toute la feuille Base de données (et donc les codes qui sont dedans) plutôt qu'insérer le code grace a la maccro Nouveau_Mois. Or moi c'est ca qu'il m'aurait fallu, vous n'avez vraiment pas d'idées comment faire :s ?
(encore) Merci, Leo.
PS: et je crois vraiment que je tenais un truc avec le on error resume next. Ne pensez pas que mon message pour vous aiguiller etait une facon de souligner votre incompétence, je suis là pour me faire aider pas donner des leçons.

eriiic · Answer

Bonjour,
une autre façon de faire, à mettre dans ThisWorkbook :
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Const feuillesNon As String = ",Accueil,toto,"    ' liste des feuilles non concernées
    If InStr(feuillesNon, "," & Sh.Name & ",") = 0 Then
        If Not Intersect(Target, Range("a1")) Is Nothing Then
            Call Reset_C: Cancel = True
        End If
        If Not Intersect(Target, Range("b1")) Is Nothing Then
            Call Reset_AF: Cancel = True
        End If
    End If
End Sub
Mais comme te dit Le pivert, si tu as un code dans une feuille il est copié en même temps que la feuille.
eric
En essayant continuellement, on finit par réussir. 
Donc plus ça rate, plus on a de chances que ça marche.(les Shadoks)
En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci

cs_Le Pivert · Answer

Tu peux dire merci à eriiic que je salue. Avec son code et ton code, on arrive a ce que tu voulais!
http://www.cjoint.com/c/GBxqPMioZiQ

LéoTaba · Answer

Ok bah merci les amis c'est good, enfin, c'est un bon compromis qui permet de garder en sureté le code de la BDD MAIS qui permet quand meme aux prochaines pages crées par le module d'être concernées par la maccro du double-clique. Dommage si mes collègues décident de créer des pages autres qu'avec le module, je les laisse se demerder pour ajouter ces feuilles dans This Workbook.
Merci cs_Le Pivert et eriiic, bonne continuation à vous !

cs_Le Pivert · Answer

C'est pas chinois quand même ce que je dis rassurez moi x) ?
Si
Mais le code d'eriiic fait exactement la même chose que si tu avais le code dans le module de la feuille. Je ne vois pas ce que cela te donne en plus de l'avoir dans la feuille! 
Ou alors il y a un truc que tu nous a pas dit: par exemple un exercice a faire!

LéoTaba · Answer

Non mais c'est bon le pivert je m'en contenterai ^^
Si tu pouvais mettre résolu STP, je ne vois pas le bouton o_O
PS: avoir le code seulement dans les feuilles crées évite de lancer la maccro en cas de missclic si on est sur une feuille non concernée

Affecter automatiquement une maccro

24 réponses

Discussions similaires

Newsletters