Recherchev de photos

J'ai oublié de stipuler que je souhaite le faire avec de la formule. J'ai
trouvé sur Excelabo des solutions de JB qui y arrive en melangeant de la
formule et du vba. Mais est ce possible sans vba.

encore merci

Manu

Bonjour,

J'ai sur feuil1 une BDD avec en colonne A des reference (C1, C2, C3......)
et en colonne B des photos. Je cherche à faire en Feuil2 comme une
recherchev de photo. c'est à dire que si je tape en F1 de Feuil2 la ref
C2, qu'il me mette la photo de la ref C2 de la feuil2

J'ai tenté diverses choses, mais impossible.

Merci

Manu

Bonjour,

Un fichier exemple : http://cjoint.com/?AIAuGd5hu1z

Le code dans la feuille module de la feuille où tu veux insérer une image
Nom des feuilles à adapter...

'---------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S As Object, R As Variant, C As Range
Dim Rg As Range, Sh As Shape, Photo As Shape
Dim Largeur As Double, hauteur As Double

Set Rg = Intersect(Target, Columns(6))
If Not Rg Is Nothing Then
With Worksheets("BDD")
'où sont les photo dans la feuille bdb
Set PlgPhoto = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
'Pour chacune des cellules de la colonne F de la feuille résultat
'qui a été modifiée
For Each C In Rg
'Recherche si la valeur entrée dans la colonne F
'Existe dans la colonne A:A de la feuille BDD
R = Application.Match(C, PlgPhoto, 0)
'Si la valeur n'existe pas, suppression de la photo
'de la colonne C de la feuille résultat
If IsError(R) Then
Err = 0
Suppression_Photo Me, C
Exit Sub
Else
'Supprimer la photo existante si elle existe
'Me -> pour l'objet feuille en cours
'C -> représente la cellule en cours de modification
Suppression_Photo Me, C
'Worksheets("BDD") -> feuille où sont les images
'Worksheets("BDD").Range("A" & R).Offset(, 1) -> cellule
'où est l'image dans la feuille BDD
'Photo objet image émanant de la feuille BDD
Insérer_La_Photo Worksheets("BDD"), _
Worksheets("BDD").Range("A" & R).Offset(, 1), Photo
'Si photo contient une image
If Not Photo Is Nothing Then
'colle la photo
Me.Paste
Set S = Selection
With C.Offset(, -3)
Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
End With
With S
.Left = C.Offset(, -3).Left
.Top = C.Offset(, -3).Top
.ShapeRange.LockAspectRatio = msoFalse
'Largeur de l'image
.Width = Largeur - 0.1
'Hauteur de l'image
.Height = hauteur
'Est-ce que l'image doit se déplacer avec les cellules
'voici les 3 constantes possibles
.Placement = xlMoveAndSize 'xlFreeFloating or xlmove
'Verrouillé ou pas
.Locked = True 'or False
C.Select
End With
End If
End If
Next
End If
Set Rg = Nothing: Set Sh = Nothing: Set S = Nothing: Set Rg1 = Nothing
End Sub

Sub Suppression_Photo(F As Worksheet, Rg As Range)
Dim RgPhoto As Range
With F
For Each Sh In .Shapes
Set RgPhoto = .Cells(Sh.TopLeftCell.Row, _
Sh.BottomRightCell.Column)
If Union(Rg.Offset(, -3), RgPhoto).Address = RgPhoto.Address Then
Sh.Delete
End If
Next
End With
End Sub
'---------------------------------------------
Sub Insérer_La_Photo(F As Worksheet, R As Range, Photo As Shape)
Dim RgPhoto As Range
With F
For Each Sh In .Shapes
Set RgPhoto = .Cells(Sh.TopLeftCell.Row, _
Sh.BottomRightCell.Column)
If Union(R, RgPhoto).Address = RgPhoto.Address Then
Set Photo = Sh
Photo.Copy
Exit Sub
End If
Next
End With
End Sub
'---------------------------------------------


MichD
------------------------------------------
"Manu" a écrit dans le message de groupe de discussion : 4e80a563$0$30784$ba4acef3@reader.news.orange.fr...

Bonjour,

J'ai sur feuil1 une BDD avec en colonne A des reference (C1, C2, C3......)
et en colonne B des photos. Je cherche à faire en Feuil2 comme une
recherchev de photo. c'est à dire que si je tape en F1 de Feuil2 la ref C2,
qu'il me mette la photo de la ref C2 de la feuil2

J'ai tenté diverses choses, mais impossible.

Merci

Manu

Ce que tu demandes est impossible par formule.


MichD
------------------------------------------

Merci Mich

Bonne journée à tous

Manu

Bonjour,

Un fichier exemple : http://cjoint.com/?AIAuGd5hu1z

Le code dans la feuille module de la feuille où tu veux insérer une image
Nom des feuilles à adapter...

'---------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S As Object, R As Variant, C As Range
Dim Rg As Range, Sh As Shape, Photo As Shape
Dim Largeur As Double, hauteur As Double

Set Rg = Intersect(Target, Columns(6))
If Not Rg Is Nothing Then
With Worksheets("BDD")
'où sont les photo dans la feuille bdb
Set PlgPhoto = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
'Pour chacune des cellules de la colonne F de la feuille résultat
'qui a été modifiée
For Each C In Rg
'Recherche si la valeur entrée dans la colonne F
'Existe dans la colonne A:A de la feuille BDD
R = Application.Match(C, PlgPhoto, 0)
'Si la valeur n'existe pas, suppression de la photo
'de la colonne C de la feuille résultat
If IsError(R) Then
Err = 0
Suppression_Photo Me, C
Exit Sub
Else
'Supprimer la photo existante si elle existe
'Me -> pour l'objet feuille en cours
'C -> représente la cellule en cours de modification
Suppression_Photo Me, C
'Worksheets("BDD") -> feuille où sont les images
'Worksheets("BDD").Range("A" & R).Offset(, 1) -> cellule
'où est l'image dans la feuille BDD
'Photo objet image émanant de la feuille BDD
Insérer_La_Photo Worksheets("BDD"), _
Worksheets("BDD").Range("A" & R).Offset(, 1), Photo
'Si photo contient une image
If Not Photo Is Nothing Then
'colle la photo
Me.Paste
Set S = Selection
With C.Offset(, -3)
Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
End With
With S
.Left = C.Offset(, -3).Left
.Top = C.Offset(, -3).Top
.ShapeRange.LockAspectRatio = msoFalse
'Largeur de l'image
.Width = Largeur - 0.1
'Hauteur de l'image
.Height = hauteur
'Est-ce que l'image doit se déplacer avec les cellules
'voici les 3 constantes possibles
.Placement = xlMoveAndSize 'xlFreeFloating or xlmove
'Verrouillé ou pas
.Locked = True 'or False
C.Select
End With
End If
End If
Next
End If
Set Rg = Nothing: Set Sh = Nothing: Set S = Nothing: Set Rg1 = Nothing
End Sub

Sub Suppression_Photo(F As Worksheet, Rg As Range)
Dim RgPhoto As Range
With F
For Each Sh In .Shapes
Set RgPhoto = .Cells(Sh.TopLeftCell.Row, _
Sh.BottomRightCell.Column)
If Union(Rg.Offset(, -3), RgPhoto).Address = RgPhoto.Address Then
Sh.Delete
End If
Next
End With
End Sub
'---------------------------------------------
Sub Insérer_La_Photo(F As Worksheet, R As Range, Photo As Shape)
Dim RgPhoto As Range
With F
For Each Sh In .Shapes
Set RgPhoto = .Cells(Sh.TopLeftCell.Row, _
Sh.BottomRightCell.Column)
If Union(R, RgPhoto).Address = RgPhoto.Address Then
Set Photo = Sh
Photo.Copy
Exit Sub
End If
Next
End With
End Sub
'---------------------------------------------


MichD
------------------------------------------
"Manu" a écrit dans le message de groupe de discussion :
4e80a563$0$30784$ba4acef3@reader.news.orange.fr...

Bonjour,

J'ai sur feuil1 une BDD avec en colonne A des reference (C1, C2, C3......)
et en colonne B des photos. Je cherche à faire en Feuil2 comme une
recherchev de photo. c'est à dire que si je tape en F1 de Feuil2 la ref
C2,
qu'il me mette la photo de la ref C2 de la feuil2

J'ai tenté diverses choses, mais impossible.

Merci

Manu