Slt,code tiré de disciplus
Le principe est le suivant :
- créer une userform contenant un contrôle Image et d'autres contrôles,
boutons,...
Dans mon exemple : la Userform est nommée "UF_images" et le contrôle Image
est nommé "IMA_image"
- dans une feuille, nommer une zone image (pour l'exemple ==> "Z_image1")
- obtention d'un n° de fichier temporaire
- création du fichier temporaire WMF à partir du contenu de la plage "Z_image1"
- copie de l'image WMF dans le contrôle Image (nommé IMA_image ) de la
UserForm nommée "UF_images"
- destruction du fichier temporaire après copie
- affichage de la UserForm
Utilisation :
--------- Code à copier dans un module ---------------------------------
Sub Miseajour_ControleImage()
Zone_Image = "Z_Image1"
Load UF_images
UF_images.Afficher_image_unique
UF_images.Show
End Sub
NOTA : on peut très bien inclure Zone_Image = "Z_Image"&Cstr(n) dans une
boucle pour faire un catalogue de n images
------- Code à copier tel quel dans le code de la userform ------------------------------
' COPIE D'IMAGE D'UN ONGLET EXCEL DANS UNE USER FORM
' VERSION SIMPLIFIEE POUR UNE SEULE IMAGE (PAS DE COPIE DIRECTE DE GRAPHIQUE EXCEL)
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
Public Num_image As Integer
Sub Afficher_image_unique()
' afficher l'image numérotée
Dim FichierTemp As String
' nom de la plage de cellules "Z_imageN" à afficher et nom de l'image
'Zone_Image = "Z_image1"
' Copie de la plage "Z_imageN "dans le fichier temporaire FichierTemp
FichierTemp = CopieFichierEMF(Sht_schemas.Range(Zone_Image))
' Copie de l'image contenue de FichierTemp dans le contrôle "IMA_image"
'et donc mise à jour de la userform
UF_images.IMA_image.Picture = LoadPicture(FichierTemp)
' Destruction du fichier temporaire
Kill FichierTemp
End Sub
Private Function CopieFichierEMF(Objet As Object) As String
' la fonction retourne le nom du fichier temporaire
CopieFichierEMF = FichierTemp
' copier l'image dans le fichier
Objet.CopyPicture
' ouvrir le presse-papier
OpenClipboard 0
' vider le presse papier et copier le fichier en format Métafichier
Windows WMF
If DeleteEnhMetaFile(CopyEnhMetaFileA(GetClipboardData(14),
CopieFichierEMF)) = 0 Then CopieFichierEMF = ""
' fermer le presse-papier
CloseClipboard
End Function
Private Function FichierTemp(Optional ByVal Chemin As String) As String
' fonction d'obtention d'un nom de fichier temporaire
' lecture du nom du répertoire des temporaires par la variable
d'environnement TMP
If Chemin = "" Then Chemin = Environ("TMP")
' initialisation du nom du fichier temporaire
FichierTemp = Space$(160)
' obtention d'un numéro de fichier temporaire
GetTempFileNameA Chemin, "", 0, FichierTemp
' nom du fichier temporaire
FichierTemp = Left$(FichierTemp, InStr(FichierTemp, vbNullChar) - 1)
End Function
