Coller contenu du presse-papiers

[Snake38000]

Bonjour,

J'essaie de faire quelque chose de très simple mais je n'y parviens pas.
Voilà, j'aimerais crééer une macro qui permet la chose suivante :

- on sélectionne d'abord une cellule
- je clique sur la macro et elle fait dans l'ordre :

• Clic droit, Lien hypertexte
• Texte à afficher : [X]
• Adresse : Ctrl+V (donc je colle une URL que j'ai au préalable copié manuellement)

Je n'arrive pas à faire le Ctrl+V dans ma macro. Voici mon code actuel :

Sub Lien()
'
' Lien Macro
'
'
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Paste _
        , TextToDisplay:="[X]"
End Sub

Est-ce que quelqu'un aurait la solution ? Je serais curieux de la savoir...

Merci !

 

[Dranreb]

Bonjour.
Créez un UserForm pour que la bibliothèque MSForms soit en ligne.

Sub Lien()
'
' Lien Macro
'
'
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=PressePapier , TextToDisplay:="[X]"
End Sub

Property Get PressePapier() As String
On Error Resume Next
With New MSForms.DataObject: .GetFromClipboard: PressePapier = .GetText: End With
If Err Then MsgBox "Pas de données récupérées", vbCritical, "PressePapier"
End Property
Property Let PressePapier(ByVal Z As String)
With New MSForms.DataObject: .SetText Z: .PutInClipboard: End With
End Property

 

[job75]

Bonjour Snake38000, Bernard,

Voyez le fichier joint et cette macro :

Sub Coller_lien()
On Error Resume Next 's'il n'y a rien à coller
ActiveSheet.Paste
ActiveCell.Hyperlinks.Add ActiveCell, ActiveCell, TextToDisplay:="[X]"
End Sub

A+

 

[yaka]

Bonjour

Je poursuis ce post.
en vba j'alimente une variable Machaine de type string avec des retours à la ligne

par exemple
Machaine = [a1].value & chr(10) & valeur de la valeur [b30].value & chr(10) & valeur de la cellule [z15].value & ...

je l'enregistre dans le presse papier pour pouvoir la coller dans une cellule et ainsi avoir autant de lignes qu'il y a de valeur (et non pas la valeur de ma variable dans une seule cellule)

ça fonctionnait très bien jusqu'il y a peu... et maintenant ça me colle ceci dans la cellule (voir entre > et <)
> <
donc rien... ???... la seule astuce que j'ai trouvé c'est de coller le presse papier dans une zone de texte et là j'ai toutes les lignes..

Par avance merci pour votre aide.

 

[Dranreb]

Bonjour.
Ça arrive souvent que le MSForms.DataObject ne fonctionne plus.
Je remplace en général le code de la Property PressePapier par quelque chose d'hélas bien plus abscons :

Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Property Let PressePapier(ByVal sUniText As String)
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Const GMEM_MOVEABLE As Long = &H2
   Const GMEM_ZEROINIT As Long = &H40
   Const CF_UNICODETEXT As Long = &HD
   OpenClipboard 0&
   EmptyClipboard
   iLen = LenB(sUniText) + 2&
   iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
   iLock = GlobalLock(iStrPtr)
   lstrcpy iLock, StrPtr(sUniText)
   GlobalUnlock iStrPtr
   SetClipboardData CF_UNICODETEXT, iStrPtr
   CloseClipboard
   End Property
Public Property Get PressePapier() As String
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Dim sUniText As String
   Const CF_UNICODETEXT As Long = 13&
   OpenClipboard 0&
   If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
       iStrPtr = GetClipboardData(CF_UNICODETEXT)
       If iStrPtr Then
           iLock = GlobalLock(iStrPtr)
           iLen = GlobalSize(iStrPtr)
           sUniText = String$(iLen \ 2& - 1&, vbNullChar)
           lstrcpy StrPtr(sUniText), iLock
           GlobalUnlock iStrPtr
       End If
       PressePapier = sUniText
   End If
   CloseClipboard
   End Property

 

[patricktoulon]

re
Bonjour @yaka , @Dranreb
si j'ai bien compris ( car des fois il nous faut des décodeurs de la Nasa pour vous comprendre)
en fait tu veux copier x cellules non contiguës dans une plage de ligne dans une colonne
et cela en créant le texte dans la variable ( machaine) avec les valeurs de ces cellules
puis tu veux pourvoir coller manuellement par le click droit--> coller
dans une colonne sur autant de ligne que de valeurs copiées

Alors

1° déjà ce n'est pas chr(10) mais vbcrlf ou chr(13)
chr(10) c'est pour les saut de ligne intra cellule)

2° oui en effet l'object dataobject déraille un peu , suite a la modification du clipboard sur les version Excel 2019 à 365
pour palier simplement au problème il te suffit de l'utiliser en late binding
(par son CLISD) et il fonctionnera comme avant

donc

voilà comme l'utiliser en late binding

Sub copieValNotContigue()
machaine = [a1].Value & vbCrLf & [b30].Value & vbCrLf & [z15].Value & vbCrLf
  With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText machaine: .PutInClipboard: End With
End Sub

après avoir lancé la sub
tu peux cliquer droite puis coller sur n'importe quelle cellule
et la copie se fera sur 3 lignes (3cellules) puisque nous avont copier 3 valeurs

Bonne journée

 

[yaka]

Bonjour Patrick et Dranreb... et merci pour vos retours.

Patrick, j'ai beau mettre mon décodeur, je ne comprends pas les termes que tu utilises (late binding, CLISD) MAIS j'ai copié puis exécuté ton code et hélas j'arrive au même résultat que celui que j'ai décrit ... ça colle uniquement que ?? que je mets entre les crochets ci-après > <

Danreb... quand je colle ton code... toutes les lignes Private Declare Function sont en rouge... je les ai déplacé au dessus de la ligne 'Option explicit'... ça reste en rouge... ?

Merci pour votre aide

 

[Dranreb]

Bonjour.
Peut être faut-il les adapter pour le 64 bits en spécifiant comme LongPtr les Long destinés aux adresses et à certains handles, puis marquer ces Declare du mot clé PtrSafe.

64bit - Excel 2013 64 bits VBA: presse-papiers de l'API ne fonctionne pas

J'ai utilisé pour être en mesure d'utiliser des appels d'API Windows en VBA Excel pour définir le texte dans le presse-papiers. Mais depuis la mise à

askcodez.com

 

[patricktoulon]

re
Bonjour
punaise plus d'un mois pour nous dire que tu a des soucis ou que tu n'y arrive pas !!???

pour info chez moi c"a fonctionne toujours

 

[yaka]

1 mois ça passe vite + j'avais complétement oublié ma demande à laquelle je me confronte à nouveau aujourd'hui
patrick > je ferai un test sur un autre pc ce soir

Dranreb > je vais essayer ce que tu me suggères

encore merci pour le temps consacré

 

[job75]

Bonjour à tous,

Quitte à exécuter une macro autant exécuter celle-ci :

Sub copieValNotContigue()
Dim a
a = Array([A1], [B30], [Z15]) 'à adapter
ActiveCell.Resize(UBound(a) + 1) = Application.Transpose(a)
End Sub

Le presse-papiers n'est pas utilisé.

A+