Clipboard avec vba [Résolu]

Messages postés
13
Date d'inscription
vendredi 3 septembre 2004
Dernière intervention
3 octobre 2006
- 15 nov. 2005 à 16:33 - Dernière réponse :
Messages postés
13
Date d'inscription
vendredi 3 septembre 2004
Dernière intervention
3 octobre 2006
- 22 nov. 2005 à 09:49
Bonjour, comment peux t-on utiliser Clipboard avec vba d'Excel ? Existe t-il une bibliothèque particulière (dll), ou bien un "ocx" qui permettrait son utilisation.
J'ai essayé sous VB sans problème mais avec des macros d'Excel il ne le reconnait pas.
La copie de texte OK mais pas d'image... merci d'avance...
Afficher la suite 

4 réponses

Meilleure réponse
Messages postés
936
Date d'inscription
lundi 19 janvier 2004
Dernière intervention
17 mars 2017
- 16 nov. 2005 à 02:17
3
Merci
lut,
j'ai trouvé ça sur la toile. Bien sur tu dois l'adapter à ton cas

'La procédure Test "copie" l'image de la cellule Feuil1!A12 dans le
'contrôle Image1 de UserForm1 et affiche celui-ci ensuite. Pas de
'problème pour remplacer Image1 par un Label ou autre contrôle ayant la
'propriété Picture.

'Pas de problème non plus... pour copier l'image d'une plage de cellules!
'Incidemment, je viens de trouver le moyen de sauvegarder une plage de
'cellules dans un fichier image au format EMF (fichier temporaire
'"FicTmp" dans cette macro, transmis ensuite tout simplement à
'LoadPicture).

'Laurent
'==================================================

Private Declare Function GetTempFileNameA Lib "Kernel32" _
(ByVal lpszPath As String, ByVal lpPrefixString As String, _
ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long

Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare Function GetClipboardData Lib "user32" _
(ByVal uFormat As Long) As Long

Private Declare Function CopyEnhMetaFileA Lib "gdi32" _
(ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
(ByVal hDC As Long) As Long

Sub Test()
'L Longre, mpfe
Dim FicTmp As String
FicTmp = Space(160)
GetTempFileNameA Environ("TMP"), "", 0, FicTmp
FicTmp = Left$(FicTmp, InStr(FicTmp, vbNullChar) - 1)
Worksheets("Feuil1").Range("A12").CopyPicture
OpenClipboard 0
DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), FicTmp)
CloseClipboard
With UserForm1
.Image1.Picture = LoadPicture(FicTmp)
Kill FicTmp
.Show
End With
End Sub

'==================================================
'Pour que ça soit plus facile à utiliser, j'ai bricolé un (tout petit)
'peu ta procédure. Ça donne ceci :
'(fs)
Sub CopiePhoto(Source As Range, Cible As Object)
Dim FicTmp As String
FicTmp = Space(160)
GetTempFileNameA Environ("TMP"), "", 0, FicTmp
FicTmp = Left$(FicTmp, InStr(FicTmp, vbNullChar) - 1)
Source.CopyPicture
OpenClipboard 0
DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), FicTmp)
CloseClipboard
On Error Resume Next
Cible.Picture = LoadPicture(FicTmp)
Kill FicTmp
End Sub

Cordialement, Jean-Paul
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partagé

Merci valtrase 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 88 internautes ce mois-ci

Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Dernière intervention
11 mars 2006
- 15 nov. 2005 à 18:36
0
Merci
Bonsoir,

En VBA c'est DataObject, mais il ne supporte que les fichiers texte.



jpleroisse
Messages postés
13
Date d'inscription
vendredi 3 septembre 2004
Dernière intervention
3 octobre 2006
- 22 nov. 2005 à 09:34
0
Merci
Bonjour,


J'ai mis en place la procédure ça fonctionne bien, ce que je regrète c'est qu'il faut passer par une feuille de calcul et non par la fonction "Clipboard" (non géré par Excel+Vba).
En tout cas merci pour cette aide précieuse....

Cordialement, Philippe
Messages postés
13
Date d'inscription
vendredi 3 septembre 2004
Dernière intervention
3 octobre 2006
- 22 nov. 2005 à 09:49
0
Merci
Bonjour,

J'ai un peu modifié la macro pour me permettre d'afficher l'image dans la boite de dialogue et ensuite l'intégrer dans un un richtextbox.

Ce qu'il manque maintenant, c'est d'afficher le contenu du richtextbox (image, texte, mise en forme texte...) dans un document Word....

Cordialement, Philippe.
*****************************************************************
Private Declare Function GetTempFileNameA Lib "Kernel32" _
(ByVal lpszPath As String, ByVal lpPrefixString As String, _
ByVal wUnique As Long, ByVal lpTempFileName As String) As Long


Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long


Private Declare Function CloseClipboard Lib "user32" () As Long


Private Declare Function GetClipboardData Lib "user32" _
(ByVal uFormat As Long) As Long


Private Declare Function CopyEnhMetaFileA Lib "gdi32" _
(ByVal hemfSrc As Long, ByVal lpszFile As String) As Long


Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
(ByVal hDC As Long) As Long
________________________________________________________________


Sub Test()
'L Longre, mpfe
On Error Resume Next
Dim FicTmp As String
Dim Ouvrir_Fichier
Ouvrir_Fichier = Application.GetOpenFilename(filefilter:="Images (*.bmp),*.bmp,Images (*.jpg),*.jpg", filterindex:= _
1, Title:="fichier images", MultiSelect:=False) 'ouverture de fichiers images
ActiveSheet.Pictures.Insert(Ouvrir_Fichier).Select
Selection.ShapeRange.ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft
FicTmp = Space(160)
GetTempFileNameA Environ("TMP"), "", 0, FicTmp
FicTmp = Left$(FicTmp, InStr(FicTmp, vbNullChar) - 1)
ActiveSheet.Shapes(2).Select '(2) n° index image sur la feuille de calcul
Selection.Copy
ActiveSheet.Shapes(2).Select
Selection.Delete
OpenClipboard 0
DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), FicTmp)
CloseClipboard
With UserForm1
.Image1.Picture = LoadPicture(FicTmp)
.Image1.PictureSizeMode = fmPictureSizeModeClip
Kill FicTmp
.Show
End With
End Sub
*****************************************************************
'Procédure à intégrer dans une userform avec un commandbutton et un richtextbox

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, iParam As Any) As Long

Const WM_PASTE = &H302
_________________________________________________________________
Private Sub CommandButton1_Click()
SendMessage RichTextBox1.hwnd, WM_PASTE, 0, 0
End Sub

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.