Clipboard avec vba
Résolu
filec
Messages postés
13
Date d'inscription
vendredi 3 septembre 2004
Statut
Membre
Dernière intervention
3 octobre 2006
-
15 nov. 2005 à 16:33
filec Messages postés 13 Date d'inscription vendredi 3 septembre 2004 Statut Membre Dernière intervention 3 octobre 2006 - 22 nov. 2005 à 09:49
filec Messages postés 13 Date d'inscription vendredi 3 septembre 2004 Statut Membre Dernière intervention 3 octobre 2006 - 22 nov. 2005 à 09:49
A voir également:
- Vba clipboard
- Clipboard vba - Meilleures réponses
- Getclipboarddata vba - Meilleures réponses
- Byval vba - Conseils pratiques -Visual Basic / VB.NET
- Vba doevents - Conseils pratiques -Visual Basic / VB.NET
- Aide vba - Conseils pratiques -Visual Basic / VB.NET
- Ubound vba - Forum Visual Basic 6
- Vba modulo ✓ - Forum Visual Basic 6
4 réponses
valtrase
Messages postés
937
Date d'inscription
lundi 19 janvier 2004
Statut
Membre
Dernière intervention
9 mai 2022
4
16 nov. 2005 à 02:17
16 nov. 2005 à 02:17
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é
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é
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
15 nov. 2005 à 18:36
15 nov. 2005 à 18:36
Bonsoir,
En VBA c'est DataObject, mais il ne supporte que les fichiers texte.
jpleroisse
En VBA c'est DataObject, mais il ne supporte que les fichiers texte.
jpleroisse
filec
Messages postés
13
Date d'inscription
vendredi 3 septembre 2004
Statut
Membre
Dernière intervention
3 octobre 2006
22 nov. 2005 à 09:34
22 nov. 2005 à 09:34
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
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
filec
Messages postés
13
Date d'inscription
vendredi 3 septembre 2004
Statut
Membre
Dernière intervention
3 octobre 2006
22 nov. 2005 à 09:49
22 nov. 2005 à 09:49
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
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
