Lancer une macro dans une macro

Le 07/07/2024 à 07:06

Bonjour,

Je suis en train de crée une macro pour automatiser un peut plus mon travail. J'arrive a faire faire à ma macro presque tout, sauf le fait de lancer une autre macro dans les tâches que je lui demande.

La macro complète (je suis plutôt fière de ce que j'ai réussi à faire, pour un débutant) :

Sub Test_copie()

    Sheets("PDJ inclus").Select
    Dim ligne
    ligne = Evaluate("max(if(J:J<>"""",row(J:J),0))")
    Range("A10:L10").Resize(ligne - 9).Select
    Selection.Copy
    Sheets("Impression Liste PDJ").Select

    Workbooks.Open Filename:="\\NTSERVER1\office\Pointage PDJ Amelys\Pointage PDJ Vide COPIER avant d'utiliser.xlsm"
    ActiveSheet.Range("A10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Pointage").Select
    Call Trier

Dim laDate As Date, lAnnee As String, leMois As String, leNom As String
 laDate = Date
 leMois = Format((laDate), "MM")
 lejour = Format((laDate), "dd")
 leNom = "Pointage PDJ " & lejour & "-" & leMois

 MsgBox leNom

Dim vdir As String
vdir = "\\NTSERVER1\office\Pointage PDJ Amelys\"

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:=vdir + leNom

ActiveWorkbook.Close True

Application.DisplayAlerts = False

End Sub

La partie qui coince est la fonction "call" au milieu de la macro. La macro que je veux lancé s'appelle "Trier" et est enregistré sur le document que je fait ouvrir et enregistré.

Sinon, je devrais recopier la macro "Trier" dans celle-ci, ce qui alourdira la macro de beaucoup. Le but est aussi que j'apprenne une nouvelle façon de faire.

Merci d'avance pour votre aide.

Le 07/07/2024 à 08:26

bonjour Ti_ti

https://exceloffthegrid.com/how-to-run-a-macro-from-another-workbook/

je suppose

Run "'Pointage PDJ Vide COPIER avant d'utiliser.xlsm'!Trier"

Le 08/07/2024 à 05:10

Malheureusement, rien ne marche. J'ai aussi essayé Application.Run comme le dit le guide que t'as mis en lien, mais toujours le même message d'erreur "erreur d'exécution '1004'.

J'ai essayé de modifier les paramètre du sécurité pour les macro, pensant que la macro est bloqué (normalement j'ai le petit message où je doit cliquer pour les activer). Mais même en mettant tout autoriser ça ne change rien, toujours le même message d'erreur disant qu'il n'arrive pas à lancer la macro.

Je ne comprend pas du tout pourquoi

Le 08/07/2024 à 08:08

re,

et si vous essayez à lancer la macro en manuel après ce message, cela fonctionne ? Ce n'est pas que vous vous trouvez dans une mauvaise feuille ou fichier ou ...

Donc avec ALT+F8 vous sélectionnez la macro sans la lancer et puis avec F8 vous la exécutez pas à pas. Cela blocque dès le début ?

Le 08/07/2024 à 22:50

Le blocage ce fait sur la ligne de lancement de la macro spécifiquement. Si je supprime cette ligne et lance la macro, tout fonctionne

Le 09/07/2024 à 08:40

je ne sais pas, cela a quelque chose à faire avec le reseau ?

macro dans titi1 & les 2 fichiers sont tous les 2 sur mon disque dur. Si cela fonctionne chez vous, alors il faut une fois déplacer titi2 vers ce reseau (peut-être protégé ou ....).

10titi1.xlsm (20.80 Ko)
15titi2.xlsm (25.09 Ko)
Sub Test_copie()
     Dim WB    As Workbook
     'Sheets("PDJ inclus").Select
     'Dim ligne
     'ligne = Evaluate("max(if(J:J<>"""",row(J:J),0))")
     'Range("A10:L10").Resize(ligne - 9).Select
     'Selection.Copy
     'Sheets("Impression Liste PDJ").Select

     'Set wb = Workbooks.Open(Filename:="\\NTSERVER1\office\Pointage PDJ Amelys\Pointage PDJ Vide COPIER avant d'utiliser.xlsm")
     Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\titi2.xlsm")     'l'autre fichier

     '4 fois la même macro
     Run "'" & WB.Name & "'!trier"           'macro dans l'autre fichier
     Run WB.Name & "!trier"                  'macro dans l'autre fichier
     Run "titi2.xlsm!trier"
     Application.Run "titi2.xlsm!trier"
End Sub
Le 12/07/2024 à 07:08

Re,

Malheureusement, rien ne fonctionne.

En effet, les 2 documents sont enregistré sur un serveur. Le "Classeur-209" est enregistré plus profondément dedans et donc avec plus de restrictions d'accès (pour des question de sécurité interne). C'est peut-être ça la cause.

Dans le doute, je joint les documents (j'ai remplacé toutes les informations sensible qu'il peut y avoir). Peut-être que ça aidera à mieux comprendre ce qu'il se passe.

La macro concernée s'appelle "Test_copie".

19classeur-209-avec-macro-test.zip (632.18 Ko)
19pointage-pdj-vide-copier-avant-d-utiliser.xlsm (101.20 Ko)
Le 12/07/2024 à 11:00

Bonjour à tous,

Je n'ai pas d'accès serveurs. En revanche, cela fonctionne localement, le code s'exécute et le trie se fait.

Ici "Trier", module4 : contenu dans le fichier "Pointag ...." sur le serveur

Plus bas : "Test_copie", module5 : contenu dans le fichier "classeur-209 ....." local.

Vérifer les noms du chemin réseau et du fichier sur le réseau.

Sub Trier()
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets("Pointage")

    Dim sortRanges As Variant
    sortRanges = Array("B2:B221", "F2:F221", "J2:J221", "N2:N221", "R2:R221", "V2:V221")

    Dim i As Integer
    For i = LBound(sortRanges) To UBound(sortRanges)
        ws.Sort.SortFields.Clear
        ws.Sort.SortFields.Add2 Key:=ws.Range(sortRanges(i)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange ws.Range(sortRanges(i))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    Next i

    ws.Range("A2").Select
End Sub
Sub Test_copie()
    On Error GoTo ErrorHandler ' Gestion des erreurs

    ' Activer la feuille "PDJ inclus"
    Sheets("PDJ inclus").Activate

    ' Définir la variable de ligne et trouver la dernière ligne non vide de la colonne J
    Dim ligne As Long
    ligne = Evaluate("MAX(IF(J:J<>"""",ROW(J:J),0))")

    ' Copier la plage de données de A10 à L10 jusqu'à la dernière ligne non vide
    Sheets("PDJ inclus").Range("A10:L10").Resize(ligne - 9).Copy

    ' Activer la feuille "Impression Liste PDJ"
    Sheets("Impression Liste PDJ").Activate

    ' Ouvrir le classeur cible
    Dim targetWorkbook As Workbook
                                                ' chemin réseau                         ' nom fichier
    Set targetWorkbook = Workbooks.Open(Filename:="\\NTSERVER1\office\Pointage PDJ Amelys\pointage-pdj-vide-copier-avant-d-utiliser.xlsm")

    ' Coller les valeurs copiées dans la feuille "Copie Liste PDJ"
    With targetWorkbook.Worksheets("Copie Liste PDJ").Range("A10")
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With

    ' Test de la présence de la macro
    If Not MacroExists(targetWorkbook, "Trier") Then
        MsgBox "La macro 'Trier' n'existe pas."
        GoTo CleanExit
    End If

    ' Exécuter la macro de tri dans le classeur cible
                      ' nom fichier
    Application.Run "'pointage-pdj-vide-copier-avant-d-utiliser.xlsm'!Trier"

    ' Définir les variables de date pour nommer le fichier
    Dim laDate As Date, leMois As String, leJour As String, leNom As String
    laDate = Date
    leMois = Format(laDate, "MM")
    leJour = Format(laDate, "dd")
    leNom = "Pointage PDJ " & leJour & "-" & leMois

    ' Afficher le nom du fichier dans une boîte de dialogue
    MsgBox leNom

    ' Définir le répertoire de sauvegarde
    Dim vdir As String
    vdir = "\\NTSERVER1\office\Pointage PDJ Amelys\"  ' chemin réseau

    ' Désactiver les alertes de sauvegarde
    Application.DisplayAlerts = False

    ' Sauvegarder le classeur cible sous le nouveau nom
    targetWorkbook.SaveAs Filename:=vdir & leNom

    ' Fermer le classeur cible et réactiver les alertes
    targetWorkbook.Close SaveChanges:=True
    Application.DisplayAlerts = True

    ' Sortie propre de la subroutine
    Exit Sub

ErrorHandler:
    ' Gérer les erreurs
    MsgBox "Une erreur s'est produite : " & Err.Description
    Application.DisplayAlerts = True

CleanExit:
    ' Réactiver les alertes si elles étaient désactivées
    Application.DisplayAlerts = True
End Sub

Function MacroExists(wb As Workbook, macroName As String) As Boolean
    Dim vbComp As Object
    Dim vbModule As Object
    Dim line As String
    Dim found As Boolean

    found = False

    For Each vbComp In wb.VBProject.VBComponents
        Set vbModule = vbComp.CodeModule
        For i = 1 To vbModule.CountOfLines
            line = vbModule.Lines(i, 1)
            If InStr(1, line, "Sub " & macroName, vbTextCompare) > 0 Then
                found = True
                Exit For
            End If
        Next i
        If found Then
            Exit For
        End If
    Next vbComp

    MacroExists = found
End Function

Bizz

Le 15/07/2024 à 06:21

Bonjour,

Merci pour le macro (je retient comment tu a refait la macro "Trier")

Malheureusement, j'ai un nouveau msg d'erreur la macro "Test_copie" (Si j'ai bien compris, c'est la msg généré par "ErrorHandler")

image

Ce msg arrive sur la partie de test de la présence de la macro.

Si j'enlève cette partie, j'ai se msg quand elle essaie de lancé la macro "Trier"

image

Encore une foi, si j'enlève l'exécution de la macro, tout fonctionne correctement.

J'en déduit que c'est un problème lié au fait que les document sont enregistré sur un serveur et au droit d'accès de ces dernier.

Ducoup, j'ai contourné le problème et ai intégré ta version simplifier de "Trier" dans la macro "Test_copie" comme ceci :

Sub Test_copie()
    On Error GoTo ErrorHandler ' Gestion des erreurs

    ' Activer la feuille "PDJ inclus"
    Sheets("PDJ inclus").Activate

    ' Définir la variable de ligne et trouver la dernière ligne non vide de la colonne J
    Dim ligne As Long
    ligne = Evaluate("MAX(IF(J:J<>"""",ROW(J:J),0))")

    ' Copier la plage de données de A10 à L10 jusqu'à la dernière ligne non vide
    Sheets("PDJ inclus").Range("A10:L10").Resize(ligne - 9).Copy

    ' Activer la feuille "Impression Liste PDJ"
    Sheets("Impression Liste PDJ").Activate

    ' Ouvrir le classeur cible
    Dim targetWorkbook As Workbook
                                                ' chemin réseau                         ' nom fichier
    Set targetWorkbook = Workbooks.Open(Filename:="\\NTSERVER1\office\Pointage PDJ Amelys\Pointage PDJ Vide COPIER avant d'utiliser.xlsm")

    ' Coller les valeurs copiées dans la feuille "Copie Liste PDJ"
    With targetWorkbook.Worksheets("Copie Liste PDJ").Range("A10")
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With

    ' insertion du contenu de la macro "Trier" pour remplacer la macro incompatible
    Dim ws As Worksheet
    Set ws = targetWorkbook.Worksheets("Pointage")

    ws.Activate

    Dim sortRanges As Variant
    sortRanges = Array("B2:B221", "F2:F221", "J2:J221", "N2:N221", "R2:R221", "V2:V221")

    Dim i As Integer
    For i = LBound(sortRanges) To UBound(sortRanges)
        ws.Sort.SortFields.Clear
        ws.Sort.SortFields.Add2 Key:=ws.Range(sortRanges(i)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange ws.Range(sortRanges(i))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    Next i

    ws.Range("A2").Select

    ' Définir les variables de date pour nommer le fichier
    Dim laDate As Date, leMois As String, leJour As String, leNom As String
    laDate = Date
    leMois = Format(laDate, "MM")
    leJour = Format(laDate, "dd")
    leNom = "Pointage PDJ " & leJour & "-" & leMois

    ' Afficher le nom du fichier dans une boîte de dialogue
    MsgBox leNom

    ' Définir le répertoire de sauvegarde
    Dim vdir As String
    vdir = "\\NTSERVER1\office\Pointage PDJ Amelys\"  ' chemin réseau

    ' Désactiver les alertes de sauvegarde
    Application.DisplayAlerts = False

    ' Sauvegarder le classeur cible sous le nouveau nom
    targetWorkbook.SaveAs Filename:=vdir & leNom

    ' Fermer le classeur cible et réactiver les alertes
    targetWorkbook.Close SaveChanges:=True
    Application.DisplayAlerts = True

    ' Sortie propre de la subroutine
    Exit Sub

ErrorHandler:
    ' Gérer les erreurs
    MsgBox "Une erreur s'est produite : " & Err.Description
    Application.DisplayAlerts = True

End Sub

Function MacroExists(wb As Workbook, macroName As String) As Boolean
    Dim vbComp As Object
    Dim vbModule As Object
    Dim line As String
    Dim found As Boolean

    found = False

    For Each vbComp In wb.VBProject.VBComponents
        Set vbModule = vbComp.CodeModule
        For i = 1 To vbModule.CountOfLines
            line = vbModule.Lines(i, 1)
            If InStr(1, line, "Sub " & macroName, vbTextCompare) > 0 Then
                found = True
                Exit For
            End If
        Next i
        If found Then
            Exit For
        End If
    Next vbComp

    MacroExists = found
End Function

Par contre, j'ai une question quand à la partie "Function". C'est la première foi que je lis une tel macro et ne comprend pas ce qu'elle fait. Je ne serait pas contre une petite explication.

Rechercher des sujets similaires à "lancer macro"