Démarrage automatique de macro sous conditions
Bonjour
j'aimerais démarrer certaines macros automatiquement à l'ouverture d'un classeur mais je n'y arrive pas
je vous joins le code
que j'ai fait mais il y a des erreurs
macros s'exécutant à l'ouverture du classeur ( environ à chaque fois 150 feuilles)
j'ai essayé pas mal de solutions mais je n'arrive en en faire fonctionner aucune
Sub Dosomething()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
xSh.Select
Call RunCode
Next
Application.ScreenUpdating = True
End Sub
Sub RunCode()
worksheet_change(ByVal target As Range)
Set target = Range("H2")
If target.Value = "A" Then
Call calca_auto
End If
If target.Value = "M" Then
Call calcm_auto
End If
If target.Value = "P" Then
Call calcp_auto
End If
If target.Value = "M" Then
Call calcm_auto
End If
If target.Value = "H" Then
Call calch_auto
End If
If target.Value = "S" Then
Call calcs_auto
End If
If target.Value = "C" Then
Call calcc_auto
End If
If target.Value = "AA" Then
Call calca_auto: Auto
End If
End Sub
voilà merçi d'avance pour votre aide et bonne soirée
Jacques
Bonjour,
Dans la partie ThisWorkbook,
Private Sub Workbook_Open() 'quand le classeur s'ouvre
Dosomething
End Sub
Et enleve la partie
worksheet_change(ByVal target As Range)
de "Sub RunCode()"
C'est le minimum a régler sans avoir de fichier exemple
A+
Bonsoir Berjac,
Après xSh.select insérer la ligne de code
Range("A1").Select
Call RunCode
Sub RunCode
Range("H2").Select: End sub
Worksheet_selectionChange(
'suite-du-code
End Sub
On remplace la macro événementielle Worksheet_Change par Worksheet_SelectionChange
Ainsi lorsque la cellule H2 est sélectionnée la macro événementielle s' active.
On pourrait simplifier en se passant de la macro RunCode. En plaçant le Range("H2"). Select dans la macro DosomeThing.
Note: cette dernière macro étant bien sur lancé par le Workbook_open.
Bonsoir et merçi Geof52 et X Cellus
je ne pourrai pas essayer avant demain car je ne suis plus sur mon ordi
mais je vous ferai un retour dès que possible encore merçi
à demain
bonne soirée
Jacques
A nouveau,
Pas de souci. Bonne fin de soirée aussi.
Et à demain.
D'ailleurs j'allais me déconnecter du site pour un film.
Bonjour à tous
voilà j'ai essayé la macro de Geof52 qui fonctionne bien par contre pour l'ouverture d'un classeur avec 200feuilles, c'est un peu plus long
et je dois toujours activer la macro sinon j'ai vérifié avec un fichier datas et ça fonctionne,
Pour X cellus
je n'arrive pas à faire la macro comme tu me le dis je vais te joindre le code et peut-être que avec celui là, lorsque je rentrerai un fichier datas,
une fois les feuilles chargées, les macros seront activées automatiquement
merçi à vous deux Génial
Sub Dosomething()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
xSh.Select
Range("A1").Select
Call RunCode
Next
Application.ScreenUpdating = True
Set target = Range("H2").Select: End Sub
Worksheet_selectionChange(
If target.Value = "A" Then
Call calca_auto
End If
If target.Value = "M" Then
Call calcm_auto
End If
If target.Value = "P" Then
Call calcp_auto
End If
If target.Value = "M" Then
Call calcm_auto
End If
If target.Value = "H" Then
Call calch_auto
End If
If target.Value = "S" Then
Call calcs_auto
End If
If target.Value = "C" Then
Call calcc_auto
End If
If target.Value = "AA" Then
Call calca_auto: Auto
End If
End Sub
Bonjour Berjac, le Fil,
Relis bien le code posté hier. Il n'y a pas de
Set Target = Range("H2"). Select
Mais la ligne d'ouverture de la macro RunCode.
Ensuite il faut comme la Worksheet_Change inscrire toute la partie entre parenthèse pour la Worksheet_selectionChange.
Soit Worksheet_selectionChange(byval Target as range)
bonjour le fil,
Activate, Select, etc ralentit la macro et est à éviter, tout dépend des macros "calcX_auto", peut-être elles sont pour 90% les mêmes, donc peut-être aussi à simplifier ...
Thisworkbook :
Private Sub Workbook_Open() 'quand le classeur s'ouvre
Dosomething
End Sub
module ordinaire
Sub Dosomething()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
Select Case xSh.Range("H2").Value
Case "A": calca_auto
Case "M": calcm_auto
Case "P": calcp_auto
Case "M": calcm_auto
Case "H": calch_auto
Case "S": calcs_auto
Case "C": calcc_auto
Case "AA": calca_auto: AUTO
End Select
Next
Application.ScreenUpdating = True
End Sub
A nouveau,
Comme indiqué dans un précédent post la macro peut être simplifiée. Notamment par une procédure Select Case.
Mais une procédure bien construite. Sans doublons... À corriger donc
Bonjour à tous et encore merçi pour votre aide
je pense que la procédure select case de Bart est la plus appropriée car toutes les macros se ressemblent
me reste juste à la faire démarrer automatiquement juste en ouvrant le classeur car après j'aurai encore une action à automatiser pour que mon classeur soit pleinement opérationnel mais pour ça l'idéal est que les macros s'activent automatiquement dès l'ouverture du classeur
pour toi X Cellus merçi et quand je met mes codes après la parenthèse et que je veux la fermer (la parenthèse)lol, ça me met une erreur mais sinon le select case est pour moi le moins gourmand je vais encore essayer à plus et merçi à tout le monde
Jacques
voilà le code de la macro qui fonctionne bien mais qui ne lance pas les macros automatiquement et qui ne revient pas à la "Feuil1" une fois que j'ai activé "Dosomething"
Si vous avez une idée pour que la macro démarre automatiquement sans mon intervention ce serait génial
bon après midi à tous et encore merçi
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
xSh.Select
Call RunCode
Next
Application.ScreenUpdating = True
End Sub
Sub RunCode()
Set target = Range("H2")
If target.Value = "A" Then
Call calca_auto
End If
If target.Value = "M" Then
Call calcm_auto
End If
If target.Value = "P" Then
Call calcp_auto
End If
If target.Value = "M" Then
Call calcm_auto
End If
If target.Value = "H" Then
Call calch_auto
End If
If target.Value = "S" Then
Call calcs_auto
End If
If target.Value = "C" Then
Call calcc_auto
End If
If target.Value = "AA" Then
Call calca_auto: Auto
End If
End Sub
Suite,
Si vous avez une idée pour que la macro démarre automatiquement sans mon intervention ce serait génial
Pour cela il faut placer ton code dans le partie ThisWorkbook de l'éditeur de macros
Faire un clic droit sur ThisWorkbook après l'avoir sélectionné. Puis clic gauche sur code dans la fenêtre ouverte.
Enfin, le textbox de gauche étant sur Workbook sélectionner dans le textbox de droite l'évènement Open.
Ainsi il est possible d'insérer ton dernier code fonctionnel.
Note que c'est aussi mon choix mais avec une macro plus simplifiée ci-dessous. Avec un contrôle d'erreur.
Private Sub Workbook_Open()
Dim xSh As Worksheet
On Error GoTo Fin 'Message d'erreur si H2 est vide ou sans correspondance
For Each xSh In Worksheets
'Appel des macros selon la lettre présente en H2
Application.Run "calc" & LCase(xSh.Range("H2")) & "_auto"
If xSh.Range("H2") = "AA" Then Auto
Next
Fin: 'Arrêt de la procédure et indication de la feuille concernée
MsgBox "Donnée H2 incorrecte en Feuille: " & xSh.Name
End Sub
Du fait que tu ajoutes la lettre trouvée en cellule H2 en fin du mot calc. Ce qui est très bien car cela permet de réduire le code.
re,
pour moi, je préférais ceci
Private Sub Workbook_Open()
Dim xSh As Worksheet
For Each xSh In Worksheets
Select Case UCase(xSh.Range("H2").Value)
Case "A", "M", "P", "H", "S", "C", "AA"
'Appel des macros selon la lettre présente en H2
Application.Run "calc" & LCase(xSh.Range("H2")) & "_auto"
If xSh.Range("H2") = "AA" Then AUTO
End Select
Next
Feuil2.Activate
End Sub
mais je voudrai voir la différence entre par exemple les macros CalcA_auto et CalcM_auto.
Public Function calcspe(a, Optional lettre = "", Optional verbose = False, Optional v = "3,2,1,0,-1")
'--------------------------------------------------------------------------
' calcspe : fonction de remplacement de nombres d'une chaine de caractères par d'autres valeurs et somme de ces valeurs
' 2 caractères alphabétiques qui se suivent reçoivent une valeur -3
' on soustrait 0,5 par nombre manquants si le nombre de nombres est inférieur à 6
' a = chaine de caractères
' v = liste des valeurs de remplacement avec par défaut 1 à remplacer par 3, 2 par 2, 3 par 1, 4 par 0 et toutes les autres valeurs par -1
' verbose (vrai/faux) pour afficher ou non le détail du calcul, faux par défaut, on n'affiche que le résultat final.
'---------------------------------------------------------------------------
tv = Split(v, ",")
ReDim vf(UBound(tv))
For i = LBound(tv) To UBound(tv)
If i = UBound(tv) Then vf(0) = "+" & tv(i) Else vf(i + 1) = "+" & tv(i)
Next i
' suppression des données entre parenthèses
s = InStr(a, "(")
Do While s > 0
s1 = InStr(a, ")")
a = Left(a, s - 1) & Mid(a, s1 + 1)
s = InStr(a, "(")
Loop
'constitution de la chaine à calculer
b = ""
i = 1
Do While i <= Len(a)
c = Mid(a, i, 1)
If c Like "#" Then
c = Val(Mid(a, i))
ch = ""
i = i + Len(c) + 1
If Val(c) <= UBound(vf) Then c = vf(c) Else c = vf(0)
ElseIf c Like "[A-z]" Then
ch = ch & c
c = ""
i = i + 1
Else
c = ""
i = i + 1
End If
If Len(ch) = 2 And (Mid(a, i - 1, 1) = lettre Or lettre = "") Then b = b & "-3": ctr = ctr + 1: ch = ""
If c <> "" And (Mid(a, i - 1, 1) = lettre Or lettre = "") Then
b = b & Replace(c, "+-", "-")
ctr = ctr + 1
End If
If ctr = 6 Then Exit Do
Loop
For i = 6 To ctr + 1 Step -1 'enleve 0,5 si nombre de nombres < 6
b = b & "-0,5"
Next i
' calcul du résultat
r = Application.Evaluate(Replace(b, ",", "."))
calcspe = IIf(verbose, IIf(lettre <> "", lettre, "") & "(" & b & ")=" & r, r)
End Function
Public Function calca(a, Optional verbose = False, Optional v = "3,2,1,0,-1")
calca = calcspe(a, "a", verbose, v)
End Function
Public Function calcp(a, Optional verbose = False, Optional v = "3,2,1,0,-1")
calcp = calcspe(a, "p", verbose, v)
End Function
Public Function calcm(a, Optional verbose = False, Optional v = "3,2,1,0,-1")
calcm = calcspe(a, "m", verbose, v)
End Function
Public Function calch(a, Optional verbose = False, Optional v = "3,2,1,0,-1")
calch = calcspe(a, "h", verbose, v)
End Function
Public Function calcs(a, Optional verbose = False, Optional v = "3,2,1,0,-1")
calcs = calcspe(a, "s", verbose, v)
End Function
Public Function calcc(a, Optional verbose = False, Optional v = "3,2,1,0,-1")
calcc = calcspe(a, "c", verbose, v)
End Function
Sub calca_auto()
'
' calca_auto Macro
'
' Touche de raccourci du clavier: Ctrl+t
'
Range("AT2").Select
ActiveCell.Formula2R1C1 = "=calca(RC[-39])"
Range("AT2").Select
Selection.AutoFill Destination:=Range("AT2:AT27")
Range("AT2:AT27").Select
Range("AV2:AV27").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("AV2:AV38"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("AV2:AY38")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub calcm_auto()
'
' calcm_auto Macro
'
' Touche de raccourci du clavier: Ctrl+m
'
Range("AT2").Select
ActiveCell.Formula2R1C1 = "=calcm(RC[-39])"
Range("AT2").Select
Selection.AutoFill Destination:=Range("AT2:AT27")
Range("AT2:AT27").Select
Range("AV2:AV27").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("AV2:AV38"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("AV2:AY38")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AS2:AS27").Select
End Sub
Sub calcp_auto()
'
' calcp_auto Macro
'
' Touche de raccourci du clavier: Ctrl+p
'
Range("AT2").Select
ActiveCell.Formula2R1C1 = "=calcp(RC[-39])"
Range("AT2").Select
Selection.AutoFill Destination:=Range("AT2:AT27")
Range("AT2:AT27").Select
Range("AV2:AV27").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("AV2:AV38"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("AV2:AY38")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub calch_auto()
'
' calch_auto Macro
'
' Touche de raccourci du clavier: Ctrl+h
'
Range("AT2").Select
ActiveCell.Formula2R1C1 = "=calch(RC[-39])"
Range("AT2").Select
Selection.AutoFill Destination:=Range("AT2:AT27")
Range("AT2:AT27").Select
Range("AV2:AV27").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("AV2:AV38"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("AV2:AY38")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub calcs_auto()
'
' calcs_auto Macro
'
' Touche de raccourci du clavier: Ctrl+s
'
Range("AT2").Select
ActiveCell.Formula2R1C1 = "=calcs(RC[-39])"
Range("AT2").Select
Selection.AutoFill Destination:=Range("AT2:AT27")
Range("AT2:AT27").Select
Range("AV2:AV27").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("AV2:AV38"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("AV2:AY38")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub calcc_auto()
'
' calcc_auto Macro
'
' Touche de raccourci du clavier: Ctrl+c
'
Range("AT2").Select
ActiveCell.Formula2R1C1 = "=calcc(RC[-39])"
Range("AT2").Select
Selection.AutoFill Destination:=Range("AT2:AT27")
Range("AT2:AT27").Select
Range("AV2:AV27").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("AV2:AV38"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("AV2:AY38")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Voilà les macros Bart,
je viens de rentrer je vais essayer tout ça Merçi Merçi Merçi à tous
Jacques
bonsoir à tous
ta dernière macro Bart,
elle bloque sur feuill2.activate
certainement car il n'y a que la feuill1 de créee les autres feuilles arrivent juste après l'injection des datas dans un fichier source qui va remplir le fichier cible et qui va générer autant de feuilles que nécéssaire
je vous joins le fichier source, le fichier cible qui doivent etre dans le meme dossier et quelques datas pour que vous puissiez vous rendre compte par vous meme
enfin si vous voulez
Et encore merçi à vous tous merçi merçi
Jacques
Bonjour, j'ai essayé depuis hier soir toutes sortes de combinaisons mais les macros ne se déclenchent pas automatiquement, je dois toujours internvenir quelque soit le code que j'emploie , je n'y comprends plus rien
je continue à chercher j'espère trouver
bonne journée à tous
Jacques
je crois avoir trouvé le problème mais ne sais comment le résoudre
en fait tout fonctionne bien sauf les macros qui ne se mettent pas en route
voilà comme mon fichier source va charger des données , il va me créer xfeuilles suivant les données insérées et c'est seulement après que ces feuilles ont été créees que je peux activer le module "Dosomething" et là tout fonctionne bien mais je ne sais pas comment l'automatiser si c'est possible donc en attendant j'ai crée un bouton "Dosometing" que j'actionne une fois mes feuilles créees et là tout est nickel
voilà merçi à tous si à tout hasard quelqu'un avait une solution mais sinon les systèmes que vous m'avez crées fonctionnent bien
bonne soirée
merçi merçi
Jacques
si je n'ai pas de réponse d'içi deux jours je fermerai le sujet
Bonsoir Berjac,
Ces feuilles créées ont un nombre prévisible ou aléatoire ?
Si, aléatoire, la dernière feuille créée pourrais être connue par une fin de données ou pas?
Bosoir X Cellus
les feuilles créees sont aléatoires car suivant les jours je peux avoir 120 feuilles comme je peux en avoir 350 le maximum de feuilles que j'ai crée en une journée est de 359 je peux éventuellement savoir le nombre exact mais je dois compter le nombre dans mes datas mais perso plus facile pour moi aléatoire
bonne soirée à toi merçi pour tes conseils et pour votre aide et à tous les intervenants du fil vous êtes géniaux
lorsque ce problème sera résolu, j'ouvrirai un autre fil pour un autre sujet mais je cherche d'abord de mon propre chef pour y arriver
bonne soirée
Jacques