Bonjour,
je souhaite créer un trombinoscope j'essaye de faire marcher ce code mais il ne fonctionne pas et je ne sais pas pourkoi ce n'est pas moi qui l'est fait
il est censée importer des images de tout un fichier à partir
du contenu (nom des fichiers) dans une plage de cellules :
Sub TestMonImage()
Dim Img As String
Dim RepImage As String
Dim Rg As Range, C As Range
Dim cellule As Range
Dim reponse As String
'---------------------------------------------------------------
' donner le répertoire ou se trouve les fichiers
'images qui sont en xxxx.jpg à la ligne ci dessous.
'---------------------------------------------------------------
RepImage = "C:\Documents and Settings\JULIE\Mes documents\RECETTES"
With Worksheets("trombi") ' Nom feuille à déterminer
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
Rg.ColumnWidth = 30
End With
For Each C In Rg
C.RowHeight = 150
If C <> "" Then
Img = RepImage & Trim(C.Value)
If Dir(Img) <> "" Then
InsererImage Rg.Parent.Name, C, Img, Trim(C)
Else
MsgBox "Aucun fichier trouvé à ce nom dans ce " & _
"répertoire : " & vbCrLf & _
RepImage & ".", vbInformation + vbOKOnly, _
"Cellule " & C.Address(0, 0) & _
" Fichier : " & C.Value
End If
End If
Next
Set Rg = Nothing: Set C = Nothing
End Sub
'----------------
Sub InsererImage(feuille As String, ByVal Rg As Range, _
NomImage As String, SonNom As String)
Dim Largeur As Double
Dim Hauteur As Double
Dim Image As Object
With Worksheets(feuille)
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)
End With
With Image
'nom de l'image
.Name = SonNom
.Left = Rg.Left + 0.01
.Top = Rg.Top + 0.01
'Largeur de l'image = largeur - 0.01
Image.Width = Largeur - 0.01
'Hauteur de l'image
Image.Height = Hauteur - 0.01
'l'image doit se déplacer avec les cellules
.Placement = xlMoveAndSize
'note, possibilité xlmove et freefloating
'verrouillé ou pas par true ou false
.Locked = False
