Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Barbapapa

XLDnaute Occasionnel
Bonjour à tous ! voici mon problème :
je cherche un moyen pour éviter de répéter des macros identiques dans plusieurs feuilles à l'aide de thisworkbook.
Par exemple disons que j'ai des feuilles nommées : feuil1 qui contient une macro1, feuil2 qui contient une macro2 et d'autres feuilles qui contiennent la même macro3.
Je souhaiterai avec l'aide de thisworkbook, écrire un code agissant ainsi :
faire répéter la macro3 sur toutes les feuilles du classeur sauf pour les feuil1 et feuil2 (qui contiennent des macros différentes).
Ce n'est pas facile à expliquer...
Bonne journée à tous et merci d'avance
Frédéric
 

Dranreb

XLDnaute Barbatruc
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Bonsoir.
Dans un cas comme ça je mets des Worksheet_Change, _Selections_Change et autres extrêmement courtes qui ne font qu'appeler des procédures d'un module standard unique à faire évoluer.
Cordialement
 

bbb38

XLDnaute Accro
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Bonjour Barbappa, le forum
Une idée avec une feuille « Menu ».
Cordialement,
Bernard

P.S. Bonjour Dranreb - Après quelques heures de sommeil, j’essaierai de comprendre ta proposition (les neurones ne suivent plus).
 

Pièces jointes

  • Essai.xls
    34.5 KB · Affichages: 157
  • Essai.xls
    34.5 KB · Affichages: 162
  • Essai.xls
    34.5 KB · Affichages: 168

Gorfael

XLDnaute Barbatruc
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Salut Barbapapa et le forum
Si tes macros sont dans les modules liés aux feuilles, c'est donc que ce sont des macros à lancement automatique.
Tu cherches l'équivalent dans ThisWorkBook et tu y mets un différentiateur qui s’appuie sur sh (variable système mise à jour au lancement et contenant la feuille - sh.Name, sh.range(), etc)
Mais impossible d'aller plus loin sans code...
A+
 

Dranreb

XLDnaute Barbatruc
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Après quelques heures de sommeil, j’essaierai de comprendre ta proposition (les neurones ne suivent plus).
C'est pourtant évident: un tel besoin vient de ce que plusieurs feuilles doivent avoir les mêmes propriétés du point de vue réaction aux évènements. La solution c'est de n'avoir qu'un code qui évolue selon les débogages et améliorations, pour ne pas être obligé de reporter chaque fois les amélioration de l'une dans toutes les autres. On peut certes utiliser la Workbook_SheetChange de ThisWorkook, mais la solution qui a ma préférence c'est de faire une Worksheet_Change identique dans toutes les feuilles du type concernée, mais tellement courte qu'elle n'aura jamais à subir de modification puisqu'elle fait simplement appel à une procédure d'un module ordinaire dédié aux évènements des feuilles de ce type, qui lui seul est de ce fait à maintenir.
 

Barbapapa

XLDnaute Occasionnel
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Bonjour et merci à tous d'avoir répondu à mon problème. Je profite de la pause de midi pour m'expliquer un peu mieux et de joindre un fichier pour plus de clarté.
Merci d'avance
Frédéric
 

Pièces jointes

  • exempleforum.xls
    63.5 KB · Affichages: 145
  • exempleforum.xls
    63.5 KB · Affichages: 151
  • exempleforum.xls
    63.5 KB · Affichages: 143

Staple1600

XLDnaute Barbatruc
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Bonjour


Essaie de cette façon
-Tu supprimes les codes dans les feuilles et tu les mets dans ThisWorkBook
ci dessous un exemple déjà modifié
Code:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'position des cellules contenant un calendrier
If Sh.Name Like "*sences" Then Exit Sub
  If Not Intersect(Target, Sh.[C13:C1000]) Is Nothing Then
    F_calendar.Show
  End If
      If Not Intersect(Target, Sh.[E13:E1000]) Is Nothing Then
    F_calendar.Show
  End If
    If Not Intersect(Target, Sh.[H13:H1000]) Is Nothing Then
    F_calendar.Show
  End If
End Sub
End Sub

PS: Proposition non testée, je te laisse donc faire les tests ;)

EDITION
: Cette fois-ci, j'ai testé et cela fonctionne sur mon PC.
 
Dernière édition:

Barbapapa

XLDnaute Occasionnel
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Désolé Staple1600 mais ça ne fonctionne pas, j'ai le message d'erreur suivant : erreur de compilation et cette ligne "Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)" est affichée en jaune.
Frédéric
 

Barbapapa

XLDnaute Occasionnel
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Merci beaucoup pour ton aide Satple1600, le code fonctionne bien. Par contre pour qu'il fonctionne j'ai supprimé un des deux End Sub à la fin... je ne sais pas pourquoi :) je suis novice et je bidouille avec le vba mais je me débrouille comme je peux. J'apprends petit à petit grâce à ce site et aux personnes qui répondent gentiment aux appels au secours.
Si tu as encore un peu de patience à me consacrer j'ai encore deux trois petites choses en suspend...
Est ce que ce code fonctionne pour les autres macros qui sont dans le fichier que j'ai mis en pièce jointe ? et peut on les modifier tel que tu l'as fait ?
J'ai aussi un petit soucis, j'ai vu dans le code que tu as mis "If Sh.Name Like "*sences" Then Exit Sub" en référence aux pages "présence et absences" sur lesquelles je ne souhaite pas que le code agisse. Le problème c'est que j'ai d'autres feuilles qui ne finissent pas par "sences" qui doivent elles aussi être exclues de ce code (ex : stagiaires, indemnités)... j'avais pas prévu le coup. Là, pareil, comment faire ?
En tout cas merci pour ta patience et bonne journée !
Frédéric
 

Barbapapa

XLDnaute Occasionnel
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Ben en fait je suis pas si malin que ça, Staple1600... je ne suis pas arrivé à faire fonctionner les autres macros en suivant l'exemple que tu m'as donnné. J'ai juste modifier la première macro pour la rendre inactive sur certaines pages.
Si tu peux m'aider encore une fois, je te donne le code complet de la page.
La première macro est celle que tu as modifié et qui fonctionne. Les autres sont à modifier avec l'aide des Sh.
Je mets aussi en pièce jointe un document ne contenant que la macro dans thisworkbook.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'position des cellules contenant un calendrier
If Sh.Name Like "Présences" Then Exit Sub
If Sh.Name Like "Absences" Then Exit Sub
If Sh.Name Like "Indemnités" Then Exit Sub
If Sh.Name Like "Stagiaires" Then Exit Sub
If Sh.Name Like "Parametres" Then Exit Sub
If Not Intersect(Target, Sh.[C13:C1000]) Is Nothing Then
F_calendar.Show
End If
If Not Intersect(Target, Sh.[E13:E1000]) Is Nothing Then
F_calendar.Show
End If
If Not Intersect(Target, Sh.[H13:H1000]) Is Nothing Then
F_calendar.Show
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ouverture automatique des liste déroulantes
On Error Resume Next
If Not Intersect([A13:A1000], Target) Is Nothing And Target.Count = 1 Then
typ = Target.Validation.Type
If typ = 3 Then SendKeys "%{down}": Target.Select
End If
On Error Resume Next
If Not Intersect([D13:D1000], Target) Is Nothing And Target.Count = 1 Then
typ = Target.Validation.Type
If typ = 3 Then SendKeys "%{down}": Target.Select
End If
On Error Resume Next
If Not Intersect([F13:F1000], Target) Is Nothing And Target.Count = 1 Then
typ = Target.Validation.Type
If typ = 3 Then SendKeys "%{down}": Target.Select
End If
On Error Resume Next
If Not Intersect([G13:G1000], Target) Is Nothing And Target.Count = 1 Then
typ = Target.Validation.Type
If typ = 3 Then SendKeys "%{down}": Target.Select
End If
On Error Resume Next
If Not Intersect([H13:H1000], Target) Is Nothing And Target.Count = 1 Then
typ = Target.Validation.Type
If typ = 3 Then SendKeys "%{down}": Target.Select
End If
End Sub
Private Sub Worksheet_Calculate()
'message en cas de dépassement nombre HS
If [F6] >= 100 Then
MsgBox "Le nombre d'heures supplémentaires doit être inférieur à 100 !" & vbLf _
& "La dernière action va être annulée !", 48
On Error Resume Next 'si l'action ne peut pas être annulée
With Application
.EnableEvents = False 's'il y a une macro Worksheet_Change
.Undo 'annule l'action
.OnRepeat "", "" 'empêche de répéter l'action
.EnableEvents = True
End With
End If
End Sub

Bonne journée !
Frédéric
 

Pièces jointes

  • macro barbapapa.xls
    37.5 KB · Affichages: 85

pierrejean

XLDnaute Barbatruc
Re : Répéter une macro sur plusieurs feuille à l'aide de thisworkbook

Bonjour

En l'absence de ce bon Staple:

Revoit les intitulés des sub dans thisworkbook obtenus a partir de la liste deroulante de droite avec Workbook dans la liste de gauche

Code:
Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Workbook_SheetCalculate(ByVal Sh As Object)
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 011
Membres
101 866
dernier inscrit
XFPRO