Discussion :

[lenylett]

Bonjour à tous,
Mon problème est simple. Je souhaiterais pouvoir choisir l'image de fond à appliquer à tous mes userforms.
Appliquer l'image à tous les userforms prenant beaucoup de place, j'ai donc pensé à n'utiliser qu'un seul contrôle image et à charger chaque userform à partir de leur propriété picture :

Code :

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

Userform2.Picture = Userform1.Image1.Picture

Cependant, la nouvelle image n'est pas conservée à la fermeture de l'userform 1. Comment conserver le changement de la propriété picture ?

Ne vaudrait-il pas mieux plutôt placer une image sur la feuille de calcul pour pouvoir l'utiliser et pouvoir la changer ? Mais alors comment me une image dans une cellule ?

C'est le même problème pour utiliser des images sur des boutons.

Merci par avance pour votre réponse.

[Theze]

Bonjour,

Une piste. Tu insères dans une feuille de calcul ton image (menu "Insertion" -->"Image") tu peux cacher la feuille afin qu'on ne voit pas cette image, tu colle le code ci-dessous dans un module standard (le code n'est absolument pas de moi mais le nom de l'auteur y est indiqué) :

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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
'---------------------------------------------------------------------------------------
'!* MODULE NAME:     Paste Picture
'!* AUTHOR & DATE:   STEPHEN BULLEN, Business Modelling Solutions Ltd.
'!*                  15 November 1998
'!* CONTACT:         Stephen@BMSLtd.co.uk
'!* WEB SITE:        http://www.BMSLtd.co.uk
'
'! un peu modifié par Thierry Pourtier (Ti) oct 2004
'---------------------------------------------------------------------------------------
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
 
Private Type uPicDesc
  Size As Long
  Type As Long
  hPic As Long
  hPal As Long
End Type
 
Private Declare Function IsClipboardFormatAvailable& Lib "user32" (ByVal wFormat&)
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, IPic As IPicture)
Private Declare Function CopyEnhMetaFile& Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
 
Const CF_BITMAP = 2, CF_PALETTE = 9, CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0, LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1, PICTYPE_ENHMETAFILE = 4
 
Private Function CreatePicture(hPic&, hPal&, lPicType&) As IPicture
Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
  With IID_IDispatch
    .Data1 = &H7BF80980
    .Data2 = &HBF32
    .Data3 = &H101A
    .Data4(0) = &H8B
    .Data4(1) = &HBB
    .Data4(2) = &H0
    .Data4(3) = &HAA
    .Data4(4) = &H0
    .Data4(5) = &H30
    .Data4(6) = &HC
    .Data4(7) = &HAB
  End With
  With uPicInfo
    .Size = Len(uPicInfo)
    .Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)
    .hPic = hPic
    .hPal = IIf(lPicType = CF_BITMAP, hPal, 0)
  End With
  OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
  Set CreatePicture = IPic
End Function
 
Function PastePicture(Optional lXlPicType& = xlPicture) As IPicture
Dim hPtr&, lPicType&, hCopy&
  lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)
 
  If IsClipboardFormatAvailable(lPicType) Then
    If OpenClipboard(0&) > 0 Then
      hPtr = GetClipboardData(lPicType)
      If lPicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
    End If
  End If
End Function

et dans le module de ton UserForm (ici, l'image s'appelle "Image 1" et est dans la feuille "Feuil1") :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub UserForm_Initialize()
 
    Dim Image As Shape
 
    Set Image = Worksheets("Feuil1").Shapes("Image 1")
 
    Image.CopyPicture xlScreen, xlPicture
 
    Set Me.Picture = PastePicture()
 
End Sub

[PMO2017]

Bonjour,

Une piste qui utilise un UserForm (USFcontainer dans l'exemple) consacré au stockage des différentes images de fond dans des contrôles Image.

J'ai construit plusieurs UserForms et les appelle avec ce style de code

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
Public IMAGE_FOND As Object
 
'#################################################################################
'### C'est ici qu'on détermine quelle image sera l'image de fond des UserForms ###
Sub InitializeFond()
'°°° Il y a 3 images dans USFcontainer, on choisit celle qu'on veut °°°
'Set IMAGE_FOND = USFcontainer.Image1.Picture
Set IMAGE_FOND = USFcontainer.Image2.Picture
'Set IMAGE_FOND = USFcontainer.Image3.Picture
End Sub
 
 
Sub aa()
'--- L'ouverture du UserForm doit être toujours en vbModeless ---
Call InitializeFond
UserForm1.Picture = IMAGE_FOND
UserForm1.Show vbModeless
End Sub
 
Sub bb()
Call InitializeFond
UserForm3.Picture = IMAGE_FOND
UserForm3.Show vbModeless
End Sub

Dans la pièce jointe, certains UserForms en appelle d'autres au sein de leur propre code.
Comme par exemple :

Code :

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

1
2
3
4
5
Private Sub CommandButton1_Click()
Call InitializeFond
UserForm4.Picture = IMAGE_FOND
UserForm4.Show vbModeless
End Sub

[lenylett]

J'ai trouvé une ligne de code permettant de conserver en dur une image.

Elle se place dans un module et s’exécute quand le formulaire n'est plus actif.

Code :

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

1
2
3
4
Sub test()
    UserForm1.Show
    ThisWorkbook.VBProject.VBComponents("UserForm1").Designer.Controls("Image1").Picture = LoadPicture(AdresseImage\Image.jpg)
End Sub

Je ne sais pas si cette solution est optimale, mais ça marche.

Si ça intéresse, voici un exemple que j'ai trouvé et que j'ai adapté à ma sauce.