Affecter automatiquement une maccro

Résolu/Fermé

LeoTaba - 13 févr. 2017 à 15:27
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 24 févr. 2017 à 08:19

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.

A voir également:

Affecter automatiquement une maccro
Automatiquement - Guide
Comment supprimer les cookies automatiquement - Guide
Mon compte gmail se connecter automatiquement - Forum Réseaux sociaux
Logiciel pour trier les photos automatiquement - Guide
Le document à télécharger comporte 19 pages. en numérotant automatiquement chaque page de ce document, on constate que sa numérotation ne commence pas à 1. quel nom d’animal apparaît sur la page avec le numéro 30 ? - Forum Bureautique

24 réponses

Réponse 1 / 24

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
17 févr. 2017 à 09:24

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
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éponse 2 / 24

LeoTaba
14 févr. 2017 à 07:59

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

Réponse 3 / 24

LeoTaba
14 févr. 2017 à 16:15

Je re-up

Réponse 4 / 24

LeoTaba
16 févr. 2017 à 07:39

Je re-up, encore

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 24

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
16 févr. 2017 à 11:59

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

Réponse 6 / 24

LéoTaba
17 févr. 2017 à 07:57

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 !

Réponse 7 / 24

LéoTaba
17 févr. 2017 à 08:02

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

Réponse 8 / 24

LéoTaba
21 févr. 2017 à 08:57

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

Réponse 9 / 24

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
21 févr. 2017 à 16:20

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

Réponse 10 / 24

LéoTaba
23 févr. 2017 à 07:50

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 Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
23 févr. 2017 à 07:55

Le code est solidaire de la feuille ainsi que toutes les données lors de la copie

Réponse 11 / 24

LéoTaba
23 févr. 2017 à 07:57

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 ?

Réponse 12 / 24

LéoTaba
23 févr. 2017 à 08:03

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.

Réponse 13 / 24

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
23 févr. 2017 à 08:08

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

Réponse 14 / 24

LéoTaba
Modifié par LéoTaba le 23/02/2017 à 08:53

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

Réponse 15 / 24

LéoTaba
Modifié par LéoTaba le 23/02/2017 à 08:57

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

Réponse 16 / 24

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
23 févr. 2017 à 11:05

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

Réponse 17 / 24

LéoTaba
Modifié par LéoTaba le 23/02/2017 à 14:46

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

Réponse 18 / 24

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
23 févr. 2017 à 15:21

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

Réponse 19 / 24

LéoTaba
Modifié par LéoTaba le 23/02/2017 à 15:51

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.

Réponse 20 / 24

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 214
Modifié par eriiic le 23/02/2017 à 16:44

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

Discussions similaires

exo pix

Remplir une cellule (texte) en fonction d'une autre (texte).

code couleur associé a une image

rester connecter en permanence sur mes messageries Gmail a la mise en marche PC

Transition automatique diapo suivant

Discussions similaires

Newsletters