Trombinoscope vba sous excel

Fermé
nina - 26 juin 2008 à 11:46
LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 - 27 juin 2008 à 17:37
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

End With
Set Rg = Nothing

End Sub
A voir également:

1 réponse

LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 337
27 juin 2008 à 17:37
bonjour

ce module fonctionne parfaitement.
complète simplement la fin du chemin des tes fichiers par un "\" :
remplace :
RepImage = "C:\Documents and Settings\JULIE\Mes documents\RECETTES"

par :
RepImage = "C:\Documents and Settings\JULIE\Mes documents\RECETTES\"


as-tu bien inscrit en colonne A (à partir de A1) le nom des fichiers à récupérer ?

à plus
0