Evenement après un coller Résolu

Question

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.

pijaku · Accepted Answer

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...

ThauTheme · Answer

Bonjour Kuartz, bonjour le forum,

Non testé mais je pense que la macro événementielle Change devrait faire l'affaire ! Non ?

pijaku · Answer

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

Evenement après un coller

3 réponses

Discussions similaires

Newsletters