Demarrage macros automatiquement à l'ouverture d'un classeur

Le 02/06/2023 à 19:43

Bonjour à tous,

j'aimerais faire démarrer des macros automatiquement à l'ouverture d'un classeur par rapport à une cellule qui contiendrait des caractères précis

donc dans la cellule "H2" si il y a la lettre "A" , démarre la macro calca_auto

Si c'est la lettre"H", la macro calch ; la lettre"S", la macro calcs_auto; la lettre "P", la macro calcp_auto ; la lettre "C", la macro calcc_auto

les lettres"AA", démarres les macros calca_auto et autostart

le classeur d'origine est toujours le même mais il duplique les feuilles à l'infini suivant les données que je rentre dans un fichier source

je vous joins un classeur type avec les macros correspondantes

j'ai essayé divers moyens mais je n'arrive à en faire fonctionner aucun

je vous souhaite à tous une bonne soirée

Jacques

1automacro.xlsm (22.32 Ko)
Le 02/06/2023 à 20:54

Bonsoir,

Je n'ai pas ouvert le fichier, ni analyser le(s) macro(s)...

J'ai juste une question méta-physique....

Le fichier est fermé, on l'ouvre par un double-clic

Dans ce fichier "ex-fermé", il y a une donnée dans la cellule H12

Mais diantre, pourquoi donc ne pas avoir exécuté ce code avant d'enregistrer le fichier?????

Mais peut-être que je n'ai pas toutes les données.....

Le 02/06/2023 à 21:17

bonsoir,

voilà , je ne comprend pas bien ce que tu me dis

j'ai deux fichiers, un fichier source ou je rentre mes données et un fichier cible qui va etre dupliqué par autant de feuilles que de données dans ce fichier cible il y a toutes les macros mais à chaque feuille crée je dois exécuter les macros manuellement j'aurais juste voulu savoir avec un code vba le moyen de démarrer une macro par le biais du contenu d'une cellule

voilà j'ai essayé plusieurs choses mais ça ne fonctionne pas

si besoin est je peux mettre le fichier cible en pièce jointe

bonne soirée

Jacques

Le 02/06/2023 à 21:31

Re-,

Tu m'as mis le doute...

J'ai donc ouvert ton fichier....

Et regardé tes codes

Rien ne fait référence à un autre fichier (où apparaît ton fichier "source", voire "cible", dans tes codes?), donc je ne vois vraiment pas pourquoi tu voudrais mettre à jour ton fichier tout nouvellement ouvert, à moins que dans ta cellule H12 ne fasse référence à la date du jour...

Bref, on peut demander à Excel de lancer des codes à l'ouverture dans l'évènement "Workbook_Open", mais, sauf gros manque d'infos dans ta question, je n'en vois vraiment pas l'utilité...

image

Dubitatif.....

Le 02/06/2023 à 22:03

je te mets le fichier source et le fichier cible en pièce jointe et ensuite peut etre comprendra tu mieux

une fois le fichier source complété avec les données il déclenche le fichie cible qui copie autant de feuilles que nécéssaire et ensuite plutot que de déclencher une macro par feuille manuellement j'aurais aimé l'automatise

fichiers en pièce jointe

voilà bonne soirée

Jacques

5fichier-cible.xlsm (128.18 Ko)
1fichier-source-v6.xlsm (27.60 Ko)
Le 04/06/2023 à 16:11

Bonjour,

voilà j'essaie de me débrouiller pour faire démarrer certaines macros par rapport à ce que contient la cellule "H2"

mais je n'y arrive pas j'ai suivi les conseils que j'ai trouvé sur le forum à droite et à gauche mais ça ne fonctionne pas

j'ai bien mis ce que j'ai besoin dans la feuille (feuil1) mais rien à faire

je vous joins les codes que j'ai inséré dans la feuille via l'éditeur de code

Tout fonctionne bien avant que je ne rajoute la partie

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If [H2] = [1] Then
        Call calca_auto
    End If
    If [H2] = [2] Then
        Call calca_auto
    End If
    If [H2] = [2] Then
        Call Auto
    End If
    If [H2] = [3] Then
        Call calcm_auto
    End If
    If [H2] = [4] Then
        Call calcp_auto
    End If
    If [H2] = [5] Then
        Call calch_auto
    End If
    If [H2] = [6] Then
        Call calcs_auto
    End If
    If [H2] = [7] Then
        Call calcc_auto
    End If

End Sub

bonne fin de journée

Jacques

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
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If [H2] = [1] Then
        Call calca_auto
    End If
    If [H2] = [2] Then
        Call calca_auto
    End If
    If [H2] = [2] Then
        Call Auto
    End If
    If [H2] = [3] Then
        Call calcm_auto
    End If
    If [H2] = [4] Then
        Call calcp_auto
    End If
    If [H2] = [5] Then
        Call calch_auto
    End If
    If [H2] = [6] Then
        Call calcs_auto
    End If
    If [H2] = [7] Then
        Call calcc_auto
    End If

End Sub
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

Sub Auto()
'
' Auto Macro
' met l'autostart automatiquement
'

'
    Range("AA4").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("AA5").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("AA6").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("AA7").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("AA8").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("AA9").Select
End Sub
Rechercher des sujets similaires à "demarrage macros automatiquement ouverture classeur"