Insérer image "à nom variable"

Version imprimable

17/07/2011, 18h08
Glawiiin

Insérer image "à nom variable"
Bonjour,

Je me permets de demander de l'aide sur votre forum pour un projet que j'ai à réaliser, voilà la question :

J'ai dans un onglet un listing quatre colonnes remplies : DATE/LIEU/DESIGNATION/PRIX en gros.

A partir de cette liste j'insère une ligne vide entre chaque ligne et redimensionne la hauteur de cette ligne (j'ai réussis seul :ccool:), mais je voudrais que pour chaque ligne, la macro cherche l'image correspondant à la désignation (placée dans un dossier).
Je comptais procéder de la manière suivante :
Code:

1 2 3 4 5 6 ActiveSheet.Pictures.Insert("F:\NOM DE LA DESIGNATION.jpg").Select With Selection .ShapeRange.Left = Sheets("MENU").Cells(i, 3).Left .ShapeRange.Top = Sheets("MENU").Cells(i, 3).Top End With
D'ou mes questions :
* Comment faire en sorte que dans le code du chemin de l'image excel prenne la valeur de la case i-1,3 et y ajoute juste ".jpg" (l'image correspondant à la désignation portera le même nom + ".jpg").
* Comment redimensionner l'image à la hauteur de la ligne

Merci
17/07/2011, 18h13
mercatog

Code:

"F:\" & Sheets("MENU").Cells(i-1,3) &".jpg"

Merci, mais j'ai encore un soucis, voilà le code que j'ai entré :
Code:

1 2 3 4 5 6 ActiveSheet.Pictures.Insert("G:\" & Sheets("RESULTAT").Cells(a - 1, 4) & ".jpg").Select With Selection .ShapeRange.Left = Sheets("RESULTAT").Cells(3, 3).Left .ShapeRange.Top = Sheets("RESULTAT").Cells(3, 3).Top End With
J'ai le message d'erreur 1004 "Impossible de lire la propriété Insert de la classe Pictures" et la première ligne est surlignée en jaune.

J'ai tout essayé, mais je ne comprends pas d'où vient le soucis...

Une autre proposition (à adapter)

Code:

1
2
3
4
5
6
7
8
9
Sub aaa()
Dim Image As String
 
With Sheets("RESULTAT")
    Image = "C:\Documents and Settings\Administrateur\Mes documents\" & .Cells(1, 1) & ".jpg"
    'Image: chemin fichier, 0: non liée, 1: enregistrer avec document, Gauche, Haut, Largeur, Hauteur
    .Shapes.AddPicture Image, 0, 1, .Cells(3, 3).Left, .Cells(3, 3).Top, 70, 50
End With
End Sub

Désolé mais je n'y arrive toujours pas...

Point positif : l'erreur précédente n'est plus d'actualité. Pour vérifier que je n'ai pas fait de bétises, voilà le code que j'ai utilisé (image sur la clé usb G):
Code:

1 2 3 4 5 6 7 Dim Image As String With Sheets("RESULTAT") Image = "G:\" & Sheets("RESULTAT").Cells(a - 1, 4).Value & ".jpeg" 'Image: chemin fichier, 0: non liée, 1: enregistrer avec document, Gauche, Haut, Largeur, Hauteur .Shapes.AddPicture Image, 0, 1, .Cells(a, 3).Left, .Cells(a, 3).Top, 70, 50 End With
L'erreur est désormais la suivante "Erreur 1004 : Le fichier spécifié est introuvable". Pourtant j'ai vérifié et essayé dans d'autres cas, à chaque fois le chemin est le bon (et c'est le bon que le programme place dans "image").
C'est désormais la ligne qui commence par .Shape.... qui est surlignée en jaune !

C'est quoi ton a?
Fais ce test et reporte ce que tu as dans les 2 msgbox

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub aaa()
Dim Image As String
 
With Sheets("RESULTAT")
    MsgBox a
    Image = "G:\" & .Cells(a - 1, 4).Value & ".jpeg"
    MsgBox Image
    'Image: chemin fichier, 0: non liée, 1: enregistrer avec document, Gauche, Haut, Largeur, Hauteur
    '.Shapes.AddPicture Image, 0, 1, .Cells(a, 3).Left, .Cells(a, 3).Top, 70, 50
End With
End Sub

a c'est une variable de la boucle While.
Le but du bout de programme est qu'à partir d'un listing, celui ci introduit une ligne vide, la redimensionne, puis insère l'image correspondant à la désignation se trouvant sur la ligne du dessus, colonne 4. (premiére ligne du listing vide !)

Voilà le code complet :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 'On insère une ligne vide entre chaque résultat obtenu et on adapte la hauteur pour préparer l'insertion de la photo Dim a As Integer a = 3 Do While Sheets("RESULTAT").Cells(a - 1, 1).Value <> Empty Rows(a).Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Selection.RowHeight = 200 'On insère la photo correspondant à la désignation Dim Image As String With Sheets("RESULTAT") Image = "G:\" & Sheets("RESULTAT").Cells(a - 1, 4).Value & ".jpeg" 'Image: chemin fichier, 0: non liée, 1: enregistrer avec document, Gauche, Haut, Largeur, Hauteur .Shapes.AddPicture Image, 0, 1, .Cells(a, 3).Left, .Cells(a, 3).Top, 70, 50 End With a = a + 2 Loop
Concernant tes MsgBox, elles renvoie la valeur de a qui s'incrémente ainsi que le chemin correctement écrit à savoir dans mon cas G:\1.jpeg (nom choisi pour tester de facon simple)

Ça ne peut venir que du nom complet des tes images.
J'ai testé ce code sans souci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Test()
Dim LastLig As Long, i As Long
Dim Image As String
 
With Sheets("RESULTAT")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = LastLig + 1 To 3 Step -1
        If .Range("A" & i - 1) <> "" Then
            .Rows(i).Insert
            .Rows(i).RowHeight = 200
            'On insère la photo correspondant à la désignation
            Image = "G:\" & .Range("D" & i - 1).Value & ".jpeg"
            'Image: chemin fichier, 0: non liée, 1: enregistrer avec document, Gauche, Haut, Largeur, Hauteur
            .Shapes.AddPicture Image, 0, 1, .Cells(i, 3).Left, .Cells(i, 3).Top, .Cells(i, 3).Width, 200
        End If
    Next i
End With
End Sub

19/07/2011, 16h51
Glawiiin

Arf ca ne fonctionne toujours pas...

J'ai utilisé ton programme (qui est, j'avoue, beaucoup plus "classe" que le mien :ccool:), mais j'obtient le même message d'erreur. J'ai pourtant vérifier 50 fois le chemin mais ca ne fonctionne pas...

Bref, merci beaucoup tout de même pour ton aide ;)

Citation:

"Erreur 1004 : Le fichier spécifié est introuvable"

C'est clair comme erreur. Regarde les noms complets des tes images.
Le lecteur G c'est quoi?

J'ai testé le code, à toi maintenant de vérifier

Au lieu d'insérer les images en C, on va écrire les chemins complets de ces images (question de revérifier)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Test()
Dim LastLig As Long, i As Long
Dim Image As String
 
With Sheets("RESULTAT")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = LastLig + 1 To 3 Step -1
        If .Range("A" & i - 1) <> "" Then
            .Rows(i).Insert
            .Rows(i).RowHeight = 200
            'On insère la photo correspondant à la désignation
            Image = "G:\" & .Range("D" & i - 1).Value & ".jpeg"
            'Image: chemin fichier, 0: non liée, 1: enregistrer avec document, Gauche, Haut, Largeur, Hauteur
            '.Shapes.AddPicture Image, 0, 1, .Cells(i, 3).Left, .Cells(i, 3).Top, .Cells(i, 3).Width, 200
            .Range("C" & i) = Image
        End If
    Next i
End With
End Sub

J'ai vraiment honte :oops:.... je me suis rendu compte que j'avais masqué les extensions sur ma clé USB, il y en avait donc deux et le chemin indiqué au départ n'était pas le bon.

Bref, merci encore car désormais cela fonctionne parfaitement. Cependant, j'ai encore deux petites questions :
* Je souhaite que la photo garde ses proporsions, je pensais utiliser la commande "LockAspectRation = msoTrue", mais à quel endroit faut-il l'insérer dans le code ci-dessous pour que celà fonctionne?
* Lorsque je souhaite effectuer une nouvelle recherche, la page RESULTAT précédemment remplie doit être vidée (en gardant le titre, ligne 1), supprimer les lignes j'arrive mais je ne sais pas comment supprimer les images. Existe-t-il un code?
Code:

1 2 3 4 5 With Sheets("RESULTAT") Image = "G:\" & Sheets("RESULTAT").Cells(a - 1, 4).Value & ".JPG" 'Image: chemin fichier, 0: non liée, 1: enregistrer avec document, Gauche, Haut, Largeur, Hauteur .Shapes.AddPicture Image, 0, 1, .Cells(a, 3).Left, .Cells(a, 3).Top, 250, 180 End With
Merci encore.