trombinoscope vba excel

[nina7121987]

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

stp merci

 

[BOISGONTIER]

Re : trombinoscope vba excel

Bonjour,

Voir PJ

Sub ImportImages2()
  repertoire = ThisWorkbook.Path
  Range("b2").Select
  Do While ActiveCell.Offset(0, -1) <> ""
     nf = repertoire & "\" & ActiveCell.Offset(0, -1) & ".jpg"
     If Dir(nf) <> "" Then
       Set monimage = ActiveSheet.Pictures.Insert(nf)
       ActiveCell.EntireRow.RowHeight = monimage.Height + 0
     End If
     ActiveCell.Offset(1, 0).Select
  Loop
End Sub

JB
Formation Excel VBA JB

 

[nina7121987]

Re : trombinoscope vba excel

Merci pour ce ptit code est ce que tu peux m'expliquer à quoi correspond offset(0,-1) car je ne sais ce qui faut que je modofie pour indiquer le chemein de mes photos et encore merci bcp

 

[jmd2]

Re : trombinoscope vba excel

hello à vous

suggestion :
insérer les photos directement dans le fichier Excel
(une photo de trombinoscope "pèse" peu)

*****

 

[BOISGONTIER]

Re : trombinoscope vba excel

On importe en colonne B
Les noms des images à importer sont en colonne A

ActiveCell.Offset(0, -1) & ".jpg" va chercher le nom de l'image à gauche de la cellule active.

JB