Microsoft 365 Une macro dans un fichier qui crée une macro event dans un autre fichier

[Michel_ja]

Bonjour,
j'aimerais savoir s'il est possible de créer une macro dans un module standard d'un fichier X qui irait ouvrir un fichier Y à une adresse précise (celle-ci étant variable) et qui créérait le code suivant: celui ci est un code d'une macro événementielle qui s'appliquerait à une feuille ou à un classeur de ce nouveau fichier. Bref une macro qui crée une macro !!!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("AM7:AM500,BA7:BG500"), Target) Is Nothing Then
Target.Offset(0, 1).Select
End If
End Sub

 

[Gégé-45550]

Bonjour,
j'aimerais savoir s'il est possible de créer une macro dans un module standard d'un fichier X qui irait ouvrir un fichier Y à une adresse précise (celle-ci étant variable) et qui créérait le code suivant: celui ci est un code d'une macro événementielle qui s'appliquerait à une feuille ou à un classeur de ce nouveau fichier. Bref une macro qui crée une macro !!!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("AM7:AM500,BA7:BG500"), Target) Is Nothing Then
Target.Offset(0, 1).Select
End If
End Sub

Bonsoir,
un truc pêché sur le Net, sans garantie car non testé, en admettant que le classeur à créer soit nommé "MonClasseur" :

' Nécessite d'activer la référence :
'"Microsoft Visual Basic for Applications Extensibility 5.3"
Sub MonCode
Dim f1 As Worksheet
Dim X As Integer
Dim code As String

Workbook(MonClasseur).Activate

    Set f1 = Worksheets("Feuil1")

    code = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf
    code = code & "     If Not Intersect(Range("AM7:AM500,BA7:BG500"), Target) Is Nothing Then" & vbCrLf
    code = code & "         Target.Offset(0, 1).Select" & vbCrLf
    code = code & "         End If" & vbCrLf
    code = code & "End Sub"

    'Ajoute la procédure dans la feuille
   With ActiveWorkbook.VBProject.VBComponents(f1.CodeName).CodeModule
        X = .CountOfLines + 1
        .InsertLines X, code
    End With

    Set f1 = Nothing
End Sub

Ce code suppose que le classeur "MonClasseur" est ouvert lorsque cette procédure est lancée.
Ne pas oublier ensuite de l'enregistrer afin de ne pas perdre les modifications.
Cordialement,

 

[TooFatBoy]

Bonjour,

Pardon, mais ça change quoi que la macro soit écrite en dur ou qu'elle soit créée par un autre classeur ?

 

[Michel_ja]

Tu veux dire TooFatBoy qu'il serait possible que la macro se crée toute seule par exemple lorsqu'on ouvrirait le fichier Y ?
Je tiens à préciser que le fichier Y est crée après un export d'une page d'un fichier X que j'enregistre sous un nom différent.
Tu aurais un exemple de code ou des liens internet sur des discussions qui pourraient m'aider ?
Merci

 

[TooFatBoy]

Tu veux dire TooFatBoy qu'il serait possible que la macro se crée toute seule par exemple lorsqu'on ouvrirait le fichier Y ?

Pas du tout.

Tu demandes une macro à mettre dans un classeur et qui va créer une macro dans une feuille d'un autre classeur.
Moi, je dis que lorsque la macro est dans la feuille à copier, elle doit rester me semble-t-il dans la feuille collée.

Et donc je demande ce que ça apporte de plus créer la macro comme tu le demandes, parce que je ne comprends pas (et je n'aime pas ne pas comprendre).

 

[Michel_ja]

Pas du tout.

Tu demandes une macro à mettre dans un classeur et qui va créer une macro dans une feuille d'un autre classeur.
Moi, je dis que lorsque la macro est dans la feuille à copier, elle doit rester me semble-t-il dans la feuille collée.

Et donc je demande ce que ça apporte de plus créer la macro comme tu le demandes, parce que je ne comprends pas (et je n'aime pas ne pas comprendre).

La macro qui est dans le classeur X contient une feuille avec plus d'une centaine de ligne de nom de collègues et c'est donc cette macro qui va créer un fichier individuel pour chaque nom de collègue grâce à une boucle. Si non, je serais obligé de créer le code dans chacun des fichiers individuels.
Et lorsque je dupplique la feuille, le code de protection de cellule Event est conservé, mais du coup il s'arrête au moment où dans la macro centrale je demande à supprimer des lignes qui sont donc protégées.
La piste de la protection des cellules en fonction de la personne qui l'ouvre me semble intéressante.
Ou alors, crée une nouvelle macro, qui rappelle tous les fichiers individuels, puis insert ce code Event et puis referme le fichier. D'où ma recherche d'une macro qui ouvre le fichier et qui insert ce code de protection. Une idée ?
J'espère que tu comprends... mais je ne suis peut-être pas clair .
Merci.

 

[TooFatBoy]

La macro qui est dans le classeur X contient une feuille avec plus d'une centaine de ligne de nom de collègues et c'est donc cette macro qui va créer un fichier individuel pour chaque nom de collègue grâce à une boucle. Si non, je serais obligé de créer le code dans chacun des fichiers individuels.

OK, je comprends. C'est parfaitement logique.

Et lorsque je dupplique la feuille, le code de protection de cellule Event est conservé, mais du coup il s'arrête au moment où dans la macro centrale je demande à supprimer des lignes qui sont donc protégées.

Là, je ne comprends pas trop ce que tu veux dire.
Tu parles bien là de la macro qui débute par Intersect ?
Et quand tu parles de protection ici, tu parles de l'Offset qui décale d'une colonne la cellule sélectionnée ?

 

[Michel_ja]

La macro centrale est celle que j'utilise pour dupliquer la feuille sur un nouveau fichier, qui lui demande de supprimer ensuite certaines lignes et puis enregistre le nouveau fichier avec le nom du collègue. Si j'ai le code de protection Intersect sur le premier fichier, et que lorsque je dupplique la feuille il est conservé, alors je ne peux plus supprimer les lignes en questions (ces lignes à supprimer sont dans la zone intersect).

 

[Dranreb]

Bonsoir.
Il serait possible d'utiliser un objet Application qui détecterait une sélection dans n'importe quelle feuille de n'importe quel classeur ouvert sans avoir besoin d'y implanter le moindre code.
Début possible dans ThisWorkbook :

Option Explicit
Private WithEvents AppXL As Application
Private Sub Workbook_Open()
   Set AppXL = Application
   End Sub
Private Sub AppXL_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

 

[Michel_ja]

Bonsoir.
Il serait possible d'utiliser un objet Application qui détecterait une sélection dans n'importe quelle feuille de n'importe quel classeur ouvert sans avoir besoin d'y implanter le moindre code.
Début possible dans ThisWorkbook :

Option Explicit
Private WithEvents AppXL As Application
Private Sub Workbook_Open()
   Set AppXL = Application
   End Sub
Private Sub AppXL_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Merci Dranreb. Je ne comprends pas trop ton idée car j'ai un niveau VBA assez faible. Cette application je l'écris dans un fichier excel ? ou c'est un code qu'on met dans des applications enregistrées quelques part sur Excel ? Est-ce que ce code application serait transmis automatiquement à mes collègues qui eux ne savent même pas ce qu'est VBA ? Merci

 

[TooFatBoy]

La macro centrale est celle que j'utilise pour dupliquer la feuille sur un nouveau fichier, qui lui demande de supprimer ensuite certaines lignes et puis enregistre le nouveau fichier avec le nom du collègue. Si j'ai le code de protection Intersect sur le premier fichier, et que lorsque je dupplique la feuille il est conservé, alors je ne peux plus supprimer les lignes en questions (ces lignes à supprimer sont dans la zone intersect).

Perso, je ne vois pas en quoi l'Intersect peut empêcher la suppression de lignes, sauf peut-être si tu utilises un Select qui n'a pas lieu d'être.

 

[Dranreb]

L'idée c'est de piloter tout ça depuis le classeur qui ouvre le fichier au lieu d'installer une macro dans ce dernier.
Ça peut se limiter aussi à une seule feuille du classeur ouvert, mais ses évènements ne peuvent être traités dans un module standard, obligatoirement dans un module objet seulement.
Si vous déclarez en tête d'un module objet Private WithEvents Wsh As Worksheet et que vous y affectez à un moment donné une expression Worksheet, vous pouvez y utiliser une Private Sub Wsh_SelectionChange(ByVal Target As Range)

 

[Michel_ja]

Je suis tenté par trouv

Perso, je ne vois pas en quoi l'Intersect peut empêcher la suppression de lignes, sauf peut-être si tu utilises un Select qui n'a pas lieu d'être.

Le code de ma macro principale est le suivant :
Sub Information_Request()
Dim DerLigne As Long
Dim Chemin As String
Dim Nom As String
Dim Nom2 As String
Dim i As Long
Dim X As Long
Dim Y As Long


Application.DisplayAlerts = False
Chemin = "\\info.corp\" '"C:\Users\"

Sheets("Information").Select
DerLigne = Columns("C:C").Find("*", Range("C1"), , , xlByRows, xlPrevious).Row

For i = 19 To 143 'DerLigne
Nom = Cells(i, 6).Value
Nom2 = Nom & "\"
Sheets(Array("Information", "Activities")).Copy 'Sheets("Information").Copy
ActiveSheet.Name = Nom

'Private Sub Worksheet_SelectionChangeV2(ByVal Target As Range)

Range("A1:BB" & DerLigne).Copy
Range("A1").PasteSpecial Paste:=xlPasteValues


Range(Columns(1), Columns(38)).Delete

Range(Rows(i + 1), Rows(DerLigne)).Delete

Range(Rows(7), Rows(i)).Select
If i = 7 Then Range(Rows(7), Rows(i)).Select
If i > 7 Then Range(Rows(7), Rows(i - 1)).Delete

Range("A3:BI4").Copy Destination:=ActiveSheet.Range("A18") 'Rows(4).Copy
Range(Rows(1), Rows(4)).Delete
Range("B3").Activate


ActiveWorkbook.SaveAs Filename:=Chemin & Nom2 & Nom & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'Si Date & " 09 May 2023"

ActiveWorkbook.Close True
Workbooks("XXX.xlsm").Activate

Next i

Workbooks("XXX.xlsm").Activate
Sheets("Information").Select
Range("A3").Activate

End Sub

Et la macro s'arrête et me renvoie un message d'erreur lorsque je supprimer les lignes. A ce moment là, le code Intersect s'est ouvert sur la nouvelle feuille créée.

 

[TooFatBoy]

Si tu utilises la balise code=vb dans tes messages, le code sera plus lisible.

Sub Information_Request()
Dim DerLigne As Long
Dim Chemin As String
Dim Nom As String
Dim Nom2 As String
Dim i As Long
Dim X As Long
Dim Y As Long

    Application.DisplayAlerts = False
    Chemin = "\\info.corp\" '"C:\Users\"

    Sheets("Information").Select
    DerLigne = Columns("C:C").Find("*", Range("C1"), , , xlByRows, xlPrevious).Row

    For i = 19 To 143 'DerLigne

        Nom = Cells(i, 6).Value
        Nom2 = Nom & "\"
        Sheets(Array("Information", "Activities")).Copy 'Sheets("Information").Copy
        ActiveSheet.Name = Nom

        'Private Sub Worksheet_SelectionChangeV2(ByVal Target As Range)

        Range("A1:BB" & DerLigne).Copy
        Range("A1").PasteSpecial Paste:=xlPasteValues

        Range(Columns(1), Columns(38)).Delete
        Range(Rows(i + 1), Rows(DerLigne)).Delete

Range(Rows(7), Rows(i)).Select
If i = 7 Then Range(Rows(7), Rows(i)).Select
If i > 7 Then Range(Rows(7), Rows(i - 1)).Delete

        Range("A3:BI4").Copy Destination:=ActiveSheet.Range("A18") 'Rows(4).Copy
        Range(Rows(1), Rows(4)).Delete
        Range("B3").Activate

        ActiveWorkbook.SaveAs Filename:=Chemin & Nom2 & Nom & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'Si Date & " 09 May 2023"
        ActiveWorkbook.Close True
        Workbooks("XXX.xlsm").Activate

    Next i

    Workbooks("XXX.xlsm").Activate
    Sheets("Information").Select
    Range("A3").Activate

End Sub