Evenement après un coller [Résolu/Fermé]

Signaler
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
-
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
-
Bonjour,

Je souhaiterais exécuter une macro automatique à chaque fois que l'utilisateur fait un "coller" sur la feuille.

En fait, j'ai un tableau qui arrive pas mail et je veux faire un copier coller des lignes du tableau sur mon fichier excel. Pas de problème, je le fais manuellement, par contre les colonnes du fichier de destination ne sont pas les mêmes que les colonnes que celles du tableau reçu par mail.

Du coup je voulais qu'à chaque fois qu'on colle une ligne sur le fichier excel, un retraitement en VBA se fasse pour décaler les données d'une colonne etc pour arriver à mettre les données au bon endroit.

Je pensais utiliser quelque chose comme :

Application.OnKey "^v", "Macro"

Mais est-ce que ça peut fonctionner? Et comment faire pour qu'à chaque fois que l'utilisateur colle, cela lance la macro?

Merci d'avance.

Cordialement.

3 réponses

Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 620
Bonjour,

On peux pour faire cela, utiliser le bouton de commande Annuler de la barre d'outils "standard". Celui-ci contient une liste des dernières actions effectuées par l'utilisateur.
On regarde si la dernière action est un coller et on lance le cas échéant.
Attention toutefois à arrêter puis relancer le gestionnaire des événements de l'application sous peine d'erreur.

Comme ceci, cela devrait te convenir :
Dans le Module Objet ThisWorkbook
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim C As String, I As Long
    With Application.CommandBars("Standard")
        I = .FindControl(ID:=128).Index
        C = .Controls(I).List(1)
    End With
    If C = "Coller" Then Macro1
End Sub

A Noter : ce code aurait pu se trouver dans le module de la feuille ou coller si cette feuille est unique... Il suffit pour cela d'utiliser l'événement Change de cette feuille.

Dans un module standard : la macro à lancer
Option Explicit

Sub Macro1()
Dim Presse_Papier As String
    'on annule le coller
    With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
    End With
    'on récupère le contenu du presse-papier
    Presse_Papier = GetPressPapier
    'Modification des colonnes
    MsgBox Presse_Papier
End Sub

Function GetPressPapier() As String
'http://excel.developpez.com/faq/?page=PressePapier#RecupPressePapier
'nécessite d'activer la référence "Microsoft Forms 2.0 Object Library."
 
    With New dataObject
        .GetFromClipboard
        GetPressPapier = .GetText(1)
    End With
End Function


Ne te reste qu'à remplacer le MsgBox par la modification du contenu du presse-papier...
2
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48 >
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021

Bizarre, lorsque je fais un copier/coller, les colonnes restent les mêmes.

Je vous joints le fichier, les données à copier/coller sont les seules présentes dans le tableau, en ligne 10.

https://www.cjoint.com/c/FGBplAEopXf

Cordialement.
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 620 >
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019

Il te faut modifier le contenu de la variable ColRemplac = Array(1, 3, 5, 7, 9, 11) de tes numéros de colonnes de destinations.
Comme ceci, par exemple :
Sub Macro1()
Dim Donnees As Variant, I As Long, J As Long
Dim ColRemplac As Variant

    ColRemplac = Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12, 15)
    'on annule le coller
    With Application
        .EnableEvents = False
        .Undo
        'on récupère le contenu du presse-papier
        'et on le place dans une variable tableau
        Donnees = Fait_Tableau(GetPressPapier)
        'Modification des colonnes
        For I = LBound(Donnees, 1) To UBound(Donnees, 1)
            For J = LBound(Donnees, 2) To UBound(Donnees, 2)
                Cells(ActiveCell.Row + I, ColRemplac(J)) = Donnees(I, J)
            Next J
        Next I
        .EnableEvents = True
        .CutCopyMode = False
    End With
    Cells(ActiveCell.Row, 1).Select
End Sub


Ton fichier en retour : https://www.cjoint.com/c/FGCgBodwGuE
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48
Je sais pas quoi te dire pour te remercier du temps passé à m'aider. Cette fois c'est bon tout fonctionne. Je pense que je vais me pencher quelques heures sur ce code afin d'en comprendre toutes les subtilités.

Merci encore infiniment.

Cordialement.
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48 >
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019

Rohhh, encore un bug...... Lorsque je copie les données sur le mail et que je fais "coller", j'ai un message : "L'indice n'appartient pas à la sélection" sur :

ReDim TB_Temp(0 To UBound(Lignes) - 1, 0 To UBound(Split(Lignes(0), Chr(9))))


Ce qui est étonnant, c'est que si jamais je fais ça, ensuite la macro ne fonctionne plus, les colonnes restent les mêmes.

Je te propose de t'envoyer le mail sur une adresse pour que tu essaye de copier la ligne du mail dans Excel et que tu vois. Il me faudra par contre ton adresse si tu veux bien.

Cordialement.
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 620 >
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019

je t'envoie un MP.
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 620
Bonjour,

Le souci rencontré tiens dans le fait que tu copies, soit une ligne, soit plusieurs, depuis un mail.
Lors de mes tests, je copiais/collais à partir d'Excel.
Or, depuis Excel, lorsque tu copies une ligne seule, le copié se termine par les caractères de changement de ligne Chr(13) & Chr(10). Par contre, le copié depuis un mail n'ajoute pas ces caractères.
Du coup, ça plantait...

De plus, tu dois également penser qu'un jour, tu vas utiliser ce fichier pour travailler dessus. Il faut donc pouvoir désactiver et réactiver ce coller un peu spécial.

Voici donc le nouveau code qui fonctionne avec les éléments transmis par mail :

!!!nécessite d'activer la référence "Microsoft Forms 2.0 Object Library."!!!
Module ThisWorkbook :
Option Explicit

Private Sub Workbook_Open()
    Call ActiveCollerSpecial
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim C As String, i As Long

    If CollerSpecialActif Then
        With Application.CommandBars("Standard")
            i = .FindControl(ID:=128).Index
            C = .Controls(i).List(1)
        End With
        If C = "Coller" Then Macro1
    End If
End Sub


Module standard : (Module1)
Option Explicit
Option Base 0

Public CollerSpecialActif As Boolean

Sub ActiveCollerSpecial()
    CollerSpecialActif = True
End Sub

Sub DesactiveCollerSpecial()
    CollerSpecialActif = False
End Sub

Sub Macro1()
Dim Donnees As Variant, NbDim As Integer
Dim strTexte As String

    'on annule le coller
    With Application
        .EnableEvents = False
        .Undo
        'on récupère le contenu du presse-papier
        strTexte = GetPressPapier
        'calcul du nombre de dimensions du tableau à créer :
        NbDim = InStr(strTexte, Chr(13) & Chr(10))
        If NbDim = 0 Then
            Donnees = Split(strTexte, Chr(9))
            Restitue Donnees, 1
        Else
            Donnees = Fait_Tableau(strTexte)
            Restitue Donnees, 2
        End If
        .EnableEvents = True
        .CutCopyMode = False
    End With
    Cells(ActiveCell.Row, 1).Select
End Sub

Function GetPressPapier() As String
'http://excel.developpez.com/faq/?page=PressePapier#RecupPressePapier
'nécessite d'activer la référence "Microsoft Forms 2.0 Object Library."
 
    With New dataObject
        .GetFromClipboard
        GetPressPapier = .GetText(1)
    End With
End Function

Function Fait_Tableau(strPp As String) As Variant()
Dim TB_Temp As Variant, Lignes As Variant, Temp As Variant, i As Long, J As Long

    Lignes = Split(strPp, vbCrLf)
    ReDim TB_Temp(0 To UBound(Lignes) - 1, 0 To UBound(Split(Lignes(0), Chr(9))))
    For i = LBound(Lignes) To UBound(Lignes)
        Temp = Split(Lignes(i), Chr(9))
        For J = LBound(Temp) To UBound(Temp)
            TB_Temp(i, J) = Temp(J)
        Next J
    Next
    Fait_Tableau = TB_Temp
    Erase TB_Temp
End Function

Sub Restitue(Tb As Variant, dimens As Integer)
Dim ColRemplac As Variant, i As Long, J As Long

    ColRemplac = Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 17, 18)
    Select Case dimens
        Case 1
            For i = LBound(Tb, 1) To UBound(Tb, 1)
                Cells(ActiveCell.Row, ColRemplac(i)) = Tb(i)
            Next i
        Case 2
            For i = LBound(Tb, 1) To UBound(Tb, 1)
                For J = LBound(Tb, 2) To UBound(Tb, 2)
                    Cells(ActiveCell.Row + i, ColRemplac(J)) = Tb(i, J)
                Next J
            Next i
    End Select
End Sub

Sub SOS()
    Application.EnableEvents = True
End Sub

2
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48
Merci infiniment Pikaju. C'est juste parfait. Bravo pour l'expertise !
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 620 >
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019

Salut,

De rien, ça a été un plaisir de travailler avec et pour toi.
A+
Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
153
Bonjour Kuartz, bonjour le forum,

Non testé mais je pense que la macro événementielle Change devrait faire l'affaire ! Non ?
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
48
Bonjour ThauTheme, bonjour le forum

Ca marcherait en effet. Mais je voulais gérer toutes les possibilités de "coller".

En fait,, l'idée c'est que lorsque je colle sur le fichier excel, les données viennent se mettre dans les bonnes colonnes. Ca paraît simple, mais vraiment pas finalement.

Merci quand même pour l'aide.