Démarrage automatique de macro sous conditions

Le 10/06/2023 à 19:29

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

Le 10/06/2023 à 20:17

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+

Le 10/06/2023 à 20:18

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.

Le 10/06/2023 à 20:36

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

Le 10/06/2023 à 20:40

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.

Le 11/06/2023 à 06:52

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

Le 11/06/2023 à 09:13

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)

Le 11/06/2023 à 09:30

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

Le 11/06/2023 à 12:36

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

Le 11/06/2023 à 12:55

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

Le 11/06/2023 à 14:05

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

Le 11/06/2023 à 15:36

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.

Le 11/06/2023 à 16:40

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.

Le 11/06/2023 à 17:59

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

Le 11/06/2023 à 18:00

Voilà les macros Bart,

je viens de rentrer je vais essayer tout ça Merçi Merçi Merçi à tous

Jacques

Le 11/06/2023 à 20:28

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

3fichier-cible.xlsm (116.64 Ko)

4fichier-source-v6.xlsm (27.60 Ko)

2classeur-essais-12062023.xlsx (16.96 Ko)

Le 12/06/2023 à 12:50

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

Le 12/06/2023 à 18:18

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

Le 12/06/2023 à 19:51

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?

Le 12/06/2023 à 20:06

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

Rechercher des sujets similaires à "demarrage automatique macro conditions"