Macro événementielle / coller le contenu du presse papier dans une cellule

**Kestion100** · 05/09/2018, 11h20

Bonjour,
Je dois copier/coller un grand nombre de fois du texte depuis des mails reçu sur outlook dans des cellules de mon tableau.
Pour éviter les CTtl V ou clics droits..., je souhaiterais que le texte copier se colle dans la cellule dès sélection de cette dernière.
Je suppose le texte copier inscrit dans le presse papier et utilise le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
 
  If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then
 
 Dim MyData As New DataObject
 Dim strClip As String
 On Error GoTo NotText
 MyData.GetFromClipboard
 strClip = MyData.GetText
 
 Cells(ActivCell.Row, 2).Select
 Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 
 Target.Offset(0, 1).Select
 
NotText:
MsgBox Error
Target.Offset(0, 1).Select
End If
 End Sub

qui me renvoie l'erreur "objet requis" dans la MsgBox MsgBox Error.

Je me pose la question de savoir si un mail au format HTML ne poserait pas ce problème?????

Merci pour tout début de solution qui me serait précieux!!!!!!!!!

**unparia** · 05/09/2018, 11h58

Bonjour
Error n'est pas un objet, mais une fonction. Cette fonction sait par exemple retourner le descriptif de l'erreur dont on lui communique l'index.
Ce n'est pas la fonction Error, qui t'est utile, mais l'objet Err (et ses propriétés)

J'observe par ailleurs (mais c'est encore autre chose) que tu passes par l'affichage d'une msgbox dans tous les cas (erreur ou non) !

**Menhir** · 05/09/2018, 12h04

Commence par supprimer le On Error, ce qui permettra d'avoir une vision plus précise et mieux localisée du problème.

Il faudrait vérifier aussi si ton Target.Offset(0, 1).Select ne déclencherait pas lui-même ta macro Worksheet_SelectionChange ce qui entrainerait un cycle infini.

**Kestion100** · 05/09/2018, 12h46

Le retour exact est: Erreur d'exécution '424': Objet requis.

Le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Target.Offset(0, 1).Select

renvoie dans la cellule voisine de colonne donc pas de pb.

Merci

**Menhir** · 05/09/2018, 13h01

Envoyé par Kestion100

Le retour exact est: Erreur d'exécution '424': Objet requis.

Quelle est la ligne de code désignée par le débugage ?

**unparia** · 05/09/2018, 13h08

Bonjour Menhir

Je crois avoir dit plus haut la raison de ce message : Error n'est pas un objet
(sans préjudice de tout le reste ...)

**Kestion100** · 05/09/2018, 13h40

Voici le nouveau code (plus d'Error, j'avais compris)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
 
 
 
 
  If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then
 
 Dim MyData As New DataObject
 Dim strClip As String
 
 MyData.GetFromClipboard
 strClip = MyData.GetText
 
 Cells(ActivCell.Row, 2).Select
 Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 
 Target.Offset(0, 1).Select
 
 
End If
 End Sub

Ligne surlignée:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(ActivCell.Row, 2).Select

**Kestion100** · 05/09/2018, 13h49

Plus de bug avec:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
 
 
 
 
  If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then
 
 Dim MyData As New DataObject
 Dim strClip As String
 
 MyData.GetFromClipboard
 strClip = MyData.GetText
 
 Range("" & "B" & ActiveCell.Row & "").Select
 Selection.PasteSpecial
 
 
 
 
 Target.Offset(0, 1).Select
 
 
End If
 End Sub

A ceci près que le collage est une image me semble-t-il, un encart avec les carrés au tour que je peux supprimer comme une zone texte?????

**patricktoulon** · 05/09/2018, 13h52

il est evident que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
 '......
'......
 Target.Offset(0, 1).Select
 
 
 End Sub

va te faire tourner en bourique et pour cause cela se passe dans l'evenement change donc tourne x fois
deja pour commencer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
application.enableevents=false
Target.Offset(0, 1).Select
application.enableevents=true

heu... c'est quoi ca ????

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("" & "B" & ActiveCell.Row & "").Select

je traduis pour que tu comprenne ma question

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(string vide & "B" & ActiveCell.Row & string vide).Select

ce qui correspond a

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(rien & "B" & ActiveCell.Row & rien).Select

ensuite plutot que d'utiliser l'evenement selection change j'utiliserais par exemple le beforerightclick tu aurais le meme effet sans les inconveniant des events

**Kestion100** · 05/09/2018, 13h56

Tu oublies:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then

Le code ne se déclenche que dans la colonne B, quand on passe dans C, rien ne se passe....et de toute façon, c'est ce qui ce passe, donc aucun pb ici.
Le fait que ce soit une image qui se colle et non du texte me pose problème en revanche

**Kestion100** · 05/09/2018, 14h01

Pour le:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 beforerightclick

: PARFAIT, MERCI!!!!!

**patricktoulon** · 05/09/2018, 14h03

Le fait que ce soit une image qui se colle et non du texte me pose problème en revanche

?????????? le dataobject ne peut contenir que du texte alors la je pige pas

qu'est ce que tu mis dans le clipboard avant de paster ???????

**Kestion100** · 05/09/2018, 14h04

Je pense que ça vient de là, je croyais l'avoir mentionné au début de la discussion:

Je copie du texte qui vient du corps d'un mail sur Outlook.....

**patricktoulon** · 05/09/2018, 14h12

re
et oui
ce mail contient il une image ,logo ,canvas,ou autre ?
comment tu copie ce mail ??(en selectionant le texte,execWeb ou autre fonction)

si il y a une image dans ce que tu copie effectivement le dataobject ne supprime pas cette image il faut astucer et c'est un peu plus compliqué que ca car il faut passer par le clipboard window et non le pseudo clipboard de excel

et entre nous ceci: te sert a quoi???

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
MyData.GetFromClipboard
 strClip = MyData.GetText
 
 Cells(ActivCell.Row, 2).Select
 Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False

si tu a l'intention de te servir de strclip plus tard ok sinon ton getdata ne te sert a rien le paste le fait tout seul
a la limite alors

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

selection.value =strclip

et tu vire ton paste

**Pierre Fauconnier** · 05/09/2018, 14h21

Salut

Envoyé par Menhir

Commence par supprimer le On Error, ce qui permettra d'avoir une vision plus précise et mieux localisée du problème.[...]

Il n'est pas nécessaire de supprimer le On Error... il suffit, dans les options du VBE, de choisir l'option "Arrêt sur toutes les erreurs" pour inhiber le gestionnaire d'erreurs. Après, il faut le remettre sur "Arrêt sur erreurs non gérées", bien entendu.

Nom : 20180905_08.png
Affichages : 615
Taille : 35,8 Ko

Nom : 20180905_08.png
Affichages : 615
Taille : 35,8 Ko

**Kestion100** · 05/09/2018, 14h51

VOILA LA SOLUTION:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

selection.value =strclip

PARFAIT!!!!!
MERIC!!!!

**patricktoulon** · 05/09/2018, 15h04

re
et oui comme je t'ai dis tout a l'heure le dataobject ne peut contenir que du texte ,mais en faisant un paste tu colle TOUT!!! ce qu'il y a dans le clipboard et non le contenu de strclip
au pire histoire d'en rire
tu aurais du faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
with MyData
.GetFromClipboard
 strClip = .GetText
.SetText strclip: .PutInClipboard
end with

et puis ton paste

Macro événementielle / coller le contenu du presse papier dans une cellule

Macros et VBA Excel

Discussions similaires

Partager

Partager