Signaler

Affecter automatiquement une maccro [Résolu]

Posez votre question LeoTaba - Dernière réponse le 24 févr. 2017 à 08:19 par cs_Le Pivert
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.
Utile
+1
plus moins
Quand je vois ce post,

http://www.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
Cette réponse vous a-t-elle aidé ?  
LéoTaba- 20 févr. 2017 à 13:56
Merci Le Pivert c'est super sympa mais bon tu vas trouver desesperant, j'ai pas le niveau pour l'adapter a mon fichier. Pourtant je vois bien que c'est hyper claire et tout mais sans qqn a coté de moi pour me guider ... c'est comme si je te disais de faire une chasse aux trésors près de ravins dans une foret hantée : c'est possible d'y arriver mais on angoisse devant la difficulté.
En tout cas, résolut (car j'ai essayé ton fichier et c'est clairement ce que je voulais).
Répondre
Donnez votre avis
Utile
+0
plus moins
up ? c'est pour le taff ca m'ammuses pas non plus x)
Donnez votre avis
Utile
+0
plus moins
Donnez votre avis
Utile
+0
plus moins
Je re-up, encore
Donnez votre avis
Utile
+0
plus moins
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!

http://www.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
Donnez votre avis
Utile
+0
plus moins
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 !
Donnez votre avis
Utile
+0
plus moins
Ok j'suis bien trop nul pour incrémenter ton code dans le mien je désespère
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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 Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Reset_C
End If
If Not Intersect(Target, Range("B1")) Is Nothing Then
Reset_AF
End If
End 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
cs_Le Pivert 4633Messages postés jeudi 13 septembre 2007Date d'inscription ContributeurStatut 22 octobre 2017 Dernière intervention - 23 févr. 2017 à 07:55
Le code est solidaire de la feuille ainsi que toutes les données lors de la copie
Répondre
Donnez votre avis
Utile
+0
plus moins
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 ?
Donnez votre avis
Utile
+0
plus moins
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.
Donnez votre avis
Utile
+0
plus moins
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

Donnez votre avis
Utile
+0
plus moins
Ok et ce code la il va sur ma feuille BDD ? ou sur le sommaire ? ou bien c'est un module ... :x ?
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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


Donnez votre avis
Utile
+0
plus moins
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 code
Code = "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
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis
Utile
+0
plus moins
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.
Donnez votre avis
Utile
+0
plus moins
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
Donnez votre avis

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !