J'ai dans un dossier photo dans c: un ensemble de 250 photos avec comme nom
pour chaque photo : 1 puis 2 etc....
J'ai dans Excel 2013 un fichier avec en colonne A les même N° 1 puis 2
etc... En colonne B C D divers éléments et je souhaiterais en colonne E les
photos associer à leurs nom en fonction du même N° de la colonne A et que la
photo s'adapte à la taille de la cellule (j'ai bien-sur bien écarté les
lignes).
Est-ce possible de faire cela ?
Merci
Manu
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Dernière chose.... lorsque je met cette ligne à la fin : .Placement = xlMove, Le trie des colonnes se passe très bien, les images suivent. en revanche lorsque je filtre, ca ne fonctionne pas.
Y a t'il une solution pour que le filtre fonctionne avec les images adéquates.
Merci
"Manu" a écrit dans le message de groupe de discussion : nfat7i$1a3e$
Merci beaucoup Mich,
Ca fonctionne nickel !!!
Bonne soirée à tous
Manu
"MichD" a écrit dans le message de groupe de discussion :
Attention aux coupures de ligne de code par le service de messagerie...
'-------------------------------------------- Sub TestMonImage() Dim Rg As Range, Ext As String, Sh As Worksheet Dim PathImg As String, Fichier As String
'///// Variables à adapter \
'Chemin où sont situées les images à adapter... PathImg = "C:Photo"
'Si le nom des fichiers en colonne A ne contient pas 'l'extension, il faut l'ajouter Ext = ".jpeg" 'Extension des fichiers images
'nom de l'onglet de la feuille oû on doit insérer l'image Set Sh = Worksheets("Feuil2")
With Sh 'Nom de la propriété Name l'objet Worksheet 'Détermine la plage où sont les noms des images Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row) End With
For Each c In Rg If c <> "" Then 'Feuil2 = nom de l'onglet de la feuille oû on doit insérer l'image 'C.Offset(, 4) cellule où est insérée l'image, Colonne E Fichier = PathImg & Trim(c.Value) 'If Right(Fichier, Len(Ext)) <> Ext Then If LCase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then Fichier = Fichier & Ext End If If Dir(Fichier, vbNormal) = "" Then MsgBox "Ce fichier """ & Trim(c) & """ n'exite pas dans ce répertoire """ & PathImg & ".""" 'Si tu désires arrêter la procédure dans un tel cas... 'End Sub End If InsérerImage Sh, c.Offset(, 4), Fichier End If Next End Sub '-------------------------------------------- Sub InsérerImage(Sh As Worksheet, Rg As Range, NomImage As String) On Error Resume Next Dim Image As Picture With Sh Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top Set Image = .Pictures.Insert(NomImage) If TypeName(Image) <> "Picture" Then Exit Sub End With With Image .ShapeRange.LockAspectRatio = msoFalse .Left = Rg.Left .Top = Rg.Top 'Largeur de l'image Image.Width = Largeur 'Hauteur de l'image Image.Height = Hauteur 'est-ce que l'image doit se déplacer avec les cellules 'voici les 3 constantes possibles .Placement = xlFreeFloating 'or xlmove or xlMoveAndSize 'verrouillé ou pas .Locked = True 'or False End With Application.ScreenUpdating = True Set Rg = Nothing End Sub
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
Dernière chose.... lorsque je met cette ligne à la fin : .Placement =
xlMove, Le trie des colonnes se passe très bien, les images suivent. en
revanche lorsque je filtre, ca ne fonctionne pas.
Y a t'il une solution pour que le filtre fonctionne avec les images
adéquates.
Merci
"Manu" a écrit dans le message de groupe de discussion :
nfat7i$1a3e$1@gioia.aioe.org...
Merci beaucoup Mich,
Ca fonctionne nickel !!!
Bonne soirée à tous
Manu
"MichD" a écrit dans le message de groupe de discussion :
5717DAC3.7050001@Hotmail.com...
Attention aux coupures de ligne de code
par le service de messagerie...
'--------------------------------------------
Sub TestMonImage()
Dim Rg As Range, Ext As String, Sh As Worksheet
Dim PathImg As String, Fichier As String
'///// Variables à adapter \\\
'Chemin où sont situées les images à adapter...
PathImg = "C:Photo"
'Si le nom des fichiers en colonne A ne contient pas
'l'extension, il faut l'ajouter
Ext = ".jpeg" 'Extension des fichiers images
'nom de l'onglet de la feuille oû on doit insérer l'image
Set Sh = Worksheets("Feuil2")
With Sh 'Nom de la propriété Name l'objet Worksheet
'Détermine la plage où sont les noms des images
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
For Each c In Rg
If c <> "" Then
'Feuil2 = nom de l'onglet de la feuille oû on doit insérer l'image
'C.Offset(, 4) cellule où est insérée l'image, Colonne E
Fichier = PathImg & Trim(c.Value)
'If Right(Fichier, Len(Ext)) <> Ext Then
If LCase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then
Fichier = Fichier & Ext
End If
If Dir(Fichier, vbNormal) = "" Then
MsgBox "Ce fichier """ & Trim(c) & """ n'exite pas dans ce
répertoire """ & PathImg & "."""
'Si tu désires arrêter la procédure dans un tel cas...
'End Sub
End If
InsérerImage Sh, c.Offset(, 4), Fichier
End If
Next
End Sub
'--------------------------------------------
Sub InsérerImage(Sh As Worksheet, Rg As Range, NomImage As String)
On Error Resume Next
Dim Image As Picture
With Sh
Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left
Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top
Set Image = .Pictures.Insert(NomImage)
If TypeName(Image) <> "Picture" Then Exit Sub
End With
With Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = Rg.Left
.Top = Rg.Top
'Largeur de l'image
Image.Width = Largeur
'Hauteur de l'image
Image.Height = Hauteur
'est-ce que l'image doit se déplacer avec les cellules
'voici les 3 constantes possibles
.Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
'verrouillé ou pas
.Locked = True 'or False
End With
Application.ScreenUpdating = True
Set Rg = Nothing
End Sub
---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
https://www.avast.com/antivirus
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Dernière chose.... lorsque je met cette ligne à la fin : .Placement = xlMove, Le trie des colonnes se passe très bien, les images suivent. en revanche lorsque je filtre, ca ne fonctionne pas.
Y a t'il une solution pour que le filtre fonctionne avec les images adéquates.
Merci
"Manu" a écrit dans le message de groupe de discussion : nfat7i$1a3e$
Merci beaucoup Mich,
Ca fonctionne nickel !!!
Bonne soirée à tous
Manu
"MichD" a écrit dans le message de groupe de discussion :
Attention aux coupures de ligne de code par le service de messagerie...
'-------------------------------------------- Sub TestMonImage() Dim Rg As Range, Ext As String, Sh As Worksheet Dim PathImg As String, Fichier As String
'///// Variables à adapter \
'Chemin où sont situées les images à adapter... PathImg = "C:Photo"
'Si le nom des fichiers en colonne A ne contient pas 'l'extension, il faut l'ajouter Ext = ".jpeg" 'Extension des fichiers images
'nom de l'onglet de la feuille oû on doit insérer l'image Set Sh = Worksheets("Feuil2")
With Sh 'Nom de la propriété Name l'objet Worksheet 'Détermine la plage où sont les noms des images Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row) End With
For Each c In Rg If c <> "" Then 'Feuil2 = nom de l'onglet de la feuille oû on doit insérer l'image 'C.Offset(, 4) cellule où est insérée l'image, Colonne E Fichier = PathImg & Trim(c.Value) 'If Right(Fichier, Len(Ext)) <> Ext Then If LCase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then Fichier = Fichier & Ext End If If Dir(Fichier, vbNormal) = "" Then MsgBox "Ce fichier """ & Trim(c) & """ n'exite pas dans ce répertoire """ & PathImg & ".""" 'Si tu désires arrêter la procédure dans un tel cas... 'End Sub End If InsérerImage Sh, c.Offset(, 4), Fichier End If Next End Sub '-------------------------------------------- Sub InsérerImage(Sh As Worksheet, Rg As Range, NomImage As String) On Error Resume Next Dim Image As Picture With Sh Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top Set Image = .Pictures.Insert(NomImage) If TypeName(Image) <> "Picture" Then Exit Sub End With With Image .ShapeRange.LockAspectRatio = msoFalse .Left = Rg.Left .Top = Rg.Top 'Largeur de l'image Image.Width = Largeur 'Hauteur de l'image Image.Height = Hauteur 'est-ce que l'image doit se déplacer avec les cellules 'voici les 3 constantes possibles .Placement = xlFreeFloating 'or xlmove or xlMoveAndSize 'verrouillé ou pas .Locked = True 'or False End With Application.ScreenUpdating = True Set Rg = Nothing End Sub
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
MichD
Un fichier exemple : http://www.cjoint.com/c/FDxpzjdqutX
l'explication :
Tu sélectionnes toutes les images, un clic droit et tu choisis la commande "Taille et propriété" et tu coches la propriété suivante : "Déplacer et dimensionner avec les cellules.
Un fichier exemple : http://www.cjoint.com/c/FDxpzjdqutX
l'explication :
Tu sélectionnes toutes les images, un clic droit et tu choisis la
commande "Taille et propriété" et tu coches la propriété suivante :
"Déplacer et dimensionner avec les cellules.
Un fichier exemple : http://www.cjoint.com/c/FDxpzjdqutX
l'explication :
Tu sélectionnes toutes les images, un clic droit et tu choisis la commande "Taille et propriété" et tu coches la propriété suivante : "Déplacer et dimensionner avec les cellules.
Manu
Merci Mich,
Bizarre, car je l'avais bien-sur déjà testé, mais ca ne fonctionnais pas, et désormais c'est nickel ! Peut-être n'avais-je pas sélectionné toutes les images.
Merci
Manu
"MichD" a écrit dans le message de groupe de discussion :
Un fichier exemple : http://www.cjoint.com/c/FDxpzjdqutX
l'explication :
Tu sélectionnes toutes les images, un clic droit et tu choisis la commande "Taille et propriété" et tu coches la propriété suivante : "Déplacer et dimensionner avec les cellules.
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
Merci Mich,
Bizarre, car je l'avais bien-sur déjà testé, mais ca ne fonctionnais pas, et
désormais c'est nickel ! Peut-être n'avais-je pas sélectionné toutes les
images.
Merci
Manu
"MichD" a écrit dans le message de groupe de discussion :
571B9756.3090301@Hotmail.com...
Un fichier exemple : http://www.cjoint.com/c/FDxpzjdqutX
l'explication :
Tu sélectionnes toutes les images, un clic droit et tu choisis la
commande "Taille et propriété" et tu coches la propriété suivante :
"Déplacer et dimensionner avec les cellules.
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Bizarre, car je l'avais bien-sur déjà testé, mais ca ne fonctionnais pas, et désormais c'est nickel ! Peut-être n'avais-je pas sélectionné toutes les images.
Merci
Manu
"MichD" a écrit dans le message de groupe de discussion :
Un fichier exemple : http://www.cjoint.com/c/FDxpzjdqutX
l'explication :
Tu sélectionnes toutes les images, un clic droit et tu choisis la commande "Taille et propriété" et tu coches la propriété suivante : "Déplacer et dimensionner avec les cellules.
--- L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast. https://www.avast.com/antivirus
