Affichage photo dans cellule depuis Useform

**carouvanai** · 26/08/2016, 09h17

Bonjour à toutes et tous,

Je me permets de poster ce message afin de solutionner/prendre des conseils concernant ma problématique/projet

Plusieurs problématiques se posent à moins :

1) problématique plus technique, je souhaite ajouter une image dans la cellule "LOGO". la partie recherche ne pose pas de soucis, c'est lors de la validation que j'ai un problème ... l'image se positionne bien dans l'image box et j'arrive bien à récupérer l'url de l'image, mais je n'arrive pas à afficher le logo. Connaissez vous une manip ?

2) Dans le bloc inférieur nommé "solutions". Actuellement je sélectionne une "prestation", de là, découle une ou plusieurs "solutions" (que je peux sélectionner) le résultats final de ma/mes sélections apparait dans la case "résumé solutions clients".
Ce que je souhaite faire c'est de pouvoir sélectionner plusieurs solutions ET plusieurs PRESTATIONS (actuellement seul plusieurs solutions fonctionne)

je vous joints le fichier en question

merci d'avance pour vos retours

PS : ceci concerne une version Office 365 2016 windows 7

**carouvanai** · 31/08/2016, 09h37

J'ai pu avancer sur différents points.

Actuellement, ma seule problématique est concernant l'affichage du logo dans la cellule concernée.

Je suis en mesure de le faire UNE fois.

Malheureusement, dès que j'essaye de réitérer l'opération, cela ne fonctionne pas, ne mets pas le logo à la bonne place, ne le redimensionne pas, bref ca fonctionne pas.

J'ai cherché un peu partout, mais rien ne se dessine précisément.

avez vous une piste ?

**Nodens_swiss** · 31/08/2016, 09h48

Hello
Je n’ai pas ouvert ton fichier mais j’ai déjà eu des problèmes comparables.
Voici un bout de code qui peut t’aider.

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub InsertLogo()
    Feuil1.Pictures.Insert("c:\path\monlogo.jpg").Name = "MonLogo"
    Set emplacement = Range("A1:I25")
    With ActiveSheet.ShapeS("MonLogo")
        .Top = emplacement.Top
        .Left = emplacement.Left
        .Height = emplacement.Height
        .Width = emplacement.Width
    End With
End Sub

La partie importante est de donner un nom à ton image insérer (".Name = "MonLogo") pour pouvoir y faire référence dans la suite de ton code (déplacement, suppression…)

**carouvanai** · 31/08/2016, 10h06

oui effectivement c'est important

mon image est deja nommé.

PS : je remet le dernier fichier à jour en PJBASE_de_code_V6.xlsm

**Nodens_swiss** · 31/08/2016, 10h15

As-tu encore un problème ? si oui, peut l’expliquer plus clairement.
Peux-tu mettre ton code ? Je n’ouvre pas de fichier annexe sans connaitre la source.

**carouvanai** · 31/08/2016, 10h35

Oui, j'ai toujours un problème.

Mon souhait général est le suivant : Remplir une case de mon tableau avec un logo (tout cela depuis un Useform). Le tout s’incrémente au fur et à mesure des différents enregistrements.

Mon problème actuel : J'arrive bien à sélectionner une image depuis mon Useform. Après validation, cette image se positionne bien dans la cellule souhaitée (redimensionnée, centrée). CEPENDANT, lorsque je fais un second enregistrement, les paramètres qui fonctionnent parfaitement lors du premier enregistrement ne fonctionnent plus. (l'image n'est plus redimensionné, jai un code erreur 481, ...)

pour les lignes de code, je te mets la partie concernant l'image :

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
Private Sub parcourir_Click()
Dim Photo As Variant
Dim Gauche, Sommet, Largeur, Hauteur As Single
Dim TheFile As Variant
Dim ThePath As String
Dim UserDir As String
 
Application.ScreenUpdating = False
 
ThePath = "C:\Mes Documents\"
 
TheFile = Application.GetOpenFilename("Fichiers bmp/gif/jpg/tiff,*.bmp;*.gif;*.jpg;*.jpeg;*.tiff")
 
If TheFile = False Then ChDir UserDir: Exit Sub
 
With Me.Image_logo
.Picture = LoadPicture(TheFile)
.Tag = TheFile
.PictureSizeMode = fmPictureSizeModeZoom
End With
 
dernier_ligne = 3
Do
    If Sheets("bd").Cells(dernier_ligne, 2).Value <> "" Then dernier_ligne = dernier_ligne + 1
Loop Until Sheets("bd").Cells(dernier_ligne, 2).Value = ""
 
Sheets("bd").Select
Cells(dernier_ligne, 1).Select
 
Gauche = Range("A" & dernier_ligne).Left
Sommet = Range("A" & dernier_ligne).Top
Largeur = Range("A" & dernier_ligne).Width
Hauteur = Range("A" & dernier_ligne).Height
 
If TheFile <> False Then
    With ActiveSheet
     .Pictures.Insert(TheFile).Name = "image"
     .Shapes("image").Height = Hauteur
     .Shapes("image").Left = Gauche + ((ActiveCell.Width - ActiveSheet.Shapes("image").Width) / 2)
     .Shapes("image").Top = Sommet
     .Shapes("image").LockAspectRatio = msoTrue
   End With
    'Feuil2.Shapes.AddPicture TheFile, True, True, Gauche, Sommet, Largeur, Hauteur
    'Feuil2.Shapes(1).LockAspectRatio = msoTrue
End If
 
'ChDir UserDir
 
Sheets("accueil").Select
 
Application.ScreenUpdating = True
 
End Sub

**Nodens_swiss** · 31/08/2016, 10h41

Première chose, il faut mettre ton code avec les balises « Code » (bouton #) C’est plus lisible.

Sinon ton problème vient du fait que tu donnes le même nom pour chaque image

Code :

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

.Name = "image"

Il faut que tu incrémentes. Par exemple :

Code :

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

.Name = "image" & i

En incrémentant i

**carouvanai** · 31/08/2016, 10h49

j'ai apporté la modification concernant le code

malheureusement ca ne fonctionne pas de mon coté

**Nodens_swiss** · 31/08/2016, 10h52

Incrémentes-tu la valeur i à chaque boucle ?
Peux-tu remettre ton code?

**carouvanai** · 31/08/2016, 10h58

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
Private Sub parcourir_Click()
Dim Photo As Variant
Dim Gauche, Sommet, Largeur, Hauteur As Single
Dim TheFile As Variant
Dim ThePath As String
Dim UserDir As String
Dim i As Integer
 
 
Application.ScreenUpdating = False
 
ThePath = "C:\Mes Documents\"
 
TheFile = Application.GetOpenFilename("Fichiers bmp/gif/jpg/tiff,*.bmp;*.gif;*.jpg;*.jpeg;*.tiff")
 
If TheFile = False Then ChDir UserDir: Exit Sub
 
With Me.Image_logo
.Picture = LoadPicture(TheFile)
.Tag = TheFile
.PictureSizeMode = fmPictureSizeModeZoom
End With
 
dernier_ligne = 3
Do
    If Sheets("bd").Cells(dernier_ligne, 2).Value <> "" Then dernier_ligne = dernier_ligne + 1
Loop Until Sheets("bd").Cells(dernier_ligne, 2).Value = ""
 
Sheets("bd").Select
Cells(dernier_ligne, 1).Select
 
Gauche = Range("A" & dernier_ligne).Left
Sommet = Range("A" & dernier_ligne).Top
Largeur = Range("A" & dernier_ligne).Width
Hauteur = Range("A" & dernier_ligne).Height
 
If TheFile <> False Then
    With ActiveSheet
     .Pictures.Insert(TheFile).Name = "image" & i
     .Shapes("image").Height = Hauteur
     .Shapes("image").Left = Gauche + ((ActiveCell.Width - ActiveSheet.Shapes("image").Width) / 2)
     .Shapes("image").Top = Sommet
     .Shapes("image").LockAspectRatio = msoTrue
   End With
    'Feuil2.Shapes.AddPicture TheFile, True, True, Gauche, Sommet, Largeur, Hauteur
    'Feuil2.Shapes(1).LockAspectRatio = msoTrue
End If
 
'ChDir UserDir
 
Sheets("accueil").Select
 
Application.ScreenUpdating = True
 
End Sub

**Nodens_swiss** · 31/08/2016, 11h14

C’est exactement ce que je dis. Tu n’incrémentes pas i
Voici les problèmes qu’il y avait dans ton code :

i doit être déclaré en public
i doit être initialiser à l’ouverture du userforme (UserForm_Initialize)
il n’y a pas que « ).Name = "image" & i » qu’il fallait changer mais aussi chaque fois que tu veux appeler cette image (toutes les lignes contenant « image »)

Voici le code avec modifications :

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
Public i As Integer
 
Private Sub UserForm_Initialize ()
    i = 1
End Sub
 
Private Sub parcourir_Click()
Dim Photo As Variant
Dim Gauche, Sommet, Largeur, Hauteur As Single
Dim TheFile As Variant
Dim ThePath As String
Dim UserDir As String
 
 
Application.ScreenUpdating = False
 
ThePath = "C:\Mes Documents\"
 
TheFile = Application.GetOpenFilename("Fichiers bmp/gif/jpg/tiff,*.bmp;*.gif;*.jpg;*.jpeg;*.tiff")
 
If TheFile = False Then ChDir UserDir: Exit Sub
 
With Me.Image_logo
.Picture = LoadPicture(TheFile)
.Tag = TheFile
.PictureSizeMode = fmPictureSizeModeZoom
End With
 
dernier_ligne = 3
Do
    If Sheets("bd").Cells(dernier_ligne, 2).Value <> "" Then dernier_ligne = dernier_ligne + 1
Loop Until Sheets("bd").Cells(dernier_ligne, 2).Value = ""
 
Sheets("bd").Select
Cells(dernier_ligne, 1).Select
 
Gauche = Range("A" & dernier_ligne).Left
Sommet = Range("A" & dernier_ligne).Top
Largeur = Range("A" & dernier_ligne).Width
Hauteur = Range("A" & dernier_ligne).Height
 
If TheFile <> False Then
    With ActiveSheet
     .Pictures.Insert(TheFile).Name = "image" & i
     .Shapes("image" & i).Height = Hauteur
     .Shapes("image" & i).Left = Gauche + ((ActiveCell.Width - ActiveSheet.Shapes("image" & i).Width) / 2)
     .Shapes("image" & i).Top = Sommet
     .Shapes("image" & i).LockAspectRatio = msoTrue
   End With
    'Feuil2.Shapes.AddPicture TheFile, True, True, Gauche, Sommet, Largeur, Hauteur
    'Feuil2.Shapes(1).LockAspectRatio = msoTrue
End If
 
'ChDir UserDir
 
Sheets("accueil").Select
 
Application.ScreenUpdating = True
i = i + 1
End Sub

Il te reste a incrémenter la cellule où tu inters l’image (dernier_ligne = 2+i par exemple)

**carouvanai** · 01/09/2016, 09h55

Quand ca veut pas ca veut pas ...

ca ne fonctionne pas de mon côté

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
Private Sub parcourir_Click()
Dim Photo As Variant
Dim Gauche, Sommet, Largeur, Hauteur As Single
Dim TheFile As Variant
Dim ThePath As String
Dim UserDir As String
l = 1
 
Application.ScreenUpdating = False
 
ThePath = "C:\Mes Documents\"
 
TheFile = Application.GetOpenFilename("Fichiers bmp/gif/jpg/tiff,*.bmp;*.gif;*.jpg;*.jpeg;*.tiff")
 
If TheFile = False Then ChDir UserDir: Exit Sub
 
With Me.Image_logo
.Picture = LoadPicture(TheFile)
.Tag = TheFile
.PictureSizeMode = fmPictureSizeModeZoom
End With
 
dernier_ligne = 2 + l
Do
    If Sheets("bd").Cells(dernier_ligne, 2).Value <> "" Then dernier_ligne = dernier_ligne + 1
Loop Until Sheets("bd").Cells(dernier_ligne, 2).Value = ""
 
Sheets("bd").Select
Cells(dernier_ligne, 1).Select
 
Gauche = Range("A" & dernier_ligne).Left
Sommet = Range("A" & dernier_ligne).Top
Largeur = Range("A" & dernier_ligne).Width
Hauteur = Range("A" & dernier_ligne).Height
 
If TheFile <> False Then
    With ActiveSheet
     .Pictures.Insert(TheFile).Name = "image" & l
     .Shapes("image" & l).Height = Hauteur
     .Shapes("image" & l).Left = Gauche + ((ActiveCell.Width - ActiveSheet.Shapes("image" & i).Width) / 2)
     .Shapes("image" & l).Top = Sommet
     .Shapes("image" & l).LockAspectRatio = msoTrue
   End With
    'Feuil2.Shapes.AddPicture TheFile, True, True, Gauche, Sommet, Largeur, Hauteur
    'Feuil2.Shapes(1).LockAspectRatio = msoTrue
End If
 
'ChDir UserDir
 
Sheets("accueil").Select
 
Application.ScreenUpdating = True
l = l + 1
End Sub

**Nodens_swiss** · 01/09/2016, 10h49

As-tu ajouté la partie suivante:

Code :

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

PrivateSub UserForm_Initialize ()    i = 1 EndSub

Elle permet à l'ouverture de ton userform de passer i=1

et c'est bizarre, des fois tu met +1 et des fois +L

**carouvanai** · 01/09/2016, 11h33

Envoyé par Nodens_swiss

As-tu ajouté la partie suivante:

Code :

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

PrivateSub UserForm_Initialize ()    i = 1 EndSub

Elle permet à l'ouverture de ton userform de passer i=1

oui j'ai bien passé "i" (L chez moi) = 1

Envoyé par Nodens_swiss

et c'est bizarre, des fois tu met +1 et des fois +L

Sur quelle ligne ?
je viens de vérifier, je ne vois que du +L

**Nodens_swiss** · 01/09/2016, 11h59

j'ai du me tromper alors.
En principe, on utilise i ou j dans ce genre de cas justement parce que 1 peut se confondre avec L (en minuscule)
Je vais pas pourvoir tester ton code avant la semaine prochaine mais celui que j'ai posté en haut fonctionne de sûr.
la seul chose qui restait à fait était le décalage de la cellule où tu colle l'image. Mon code colle chaque fois l'image au même endroit. Si tu lnce le code 2 fois, tu va avoir 2 images superposées l'une sur l'autre.

**carouvanai** · 01/09/2016, 12h06

oui voila c'est cela
les deux images sont super positionnées
la deuxième en revanche n'est plus dimensionnée comme il se doit

**Nodens_swiss** · 06/09/2016, 15h17

Désolé j'étais un absent.
Quand j'ai fais les essais, les deux images étaient superposer et de même taille.
Essaye d'incrémenter dernier_ligne et ça devrait marcher