Insertion d'images

[Infogroup]

Bonjour à tous,

Avec Excel 2003, je voudrais insérer dans une feuille des photos ( fichiers jpg ) qui se trouvent dans le répertoire D:\Copie, et affecter à ces photos insérées le nom qu'elle porte dans l'explorateur, et non le nom que Excel lui attribue du style Imgae_001
Ce nom devra figurer sous la photo insérée.
Je souhaite mettre 4 photos par rangée, la 5ième se trouvant sur la rangée du dessous etc..
Je sais ajuster pour cela la taille des photos par ShapeRange.Width et Height

Merci par avance pour votre aide

Cordialement

Infogroup

 

[pierrejean]

Re : Insertion d'images

Bonjour infogroup

Avec un petit fichier exemple , il serait plus simple de t'aider

 

[BOISGONTIER]

Re : Insertion d'images

Bonsoir,

Voir PJ

Sub essai()
  ActiveSheet.DrawingObjects.Delete
  rep = "c:\mesdoc\"
  nf = Dir(rep & "*.jpg")
  lig = 3
  col = 1
  Do While nf <> ""
     Cells(lig, col).Select
     'On Error Resume Next
     Set monimage = ActiveSheet.Pictures.Insert(rep & nf)
     If Err = 0 Then
       monimage.Height = ActiveCell.Height
       monimage.Width = ActiveCell.Width
       monimage.Name = Left(nf, Len(nf) - 4)
       Cells(lig + 1, col) = Left(nf, Len(nf) - 4)
       col = col + 1
       If col = 5 Then col = 1: lig = lig + 2
     End If
     On Error GoTo 0
     nf = Dir
  Loop
End Sub

JB

 

[Infogroup]

Re : Insertion d'images

Bonjour infogroup

Avec un petit fichier exemple , il serait plus simple de t'aider

Je joints un petit fichier exemple (Classeur3.xls )

 

[Infogroup]

Re : Insertion d'images

Bonsoir,

Voir PJ

Sub essai()
  ActiveSheet.DrawingObjects.Delete
  rep = "c:\mesdoc\"
  nf = Dir(rep & "*.jpg")
  lig = 3
  col = 1
  Do While nf <> ""
     Cells(lig, col).Select
     'On Error Resume Next
     Set monimage = ActiveSheet.Pictures.Insert(rep & nf)
     If Err = 0 Then
       monimage.Height = ActiveCell.Height
       monimage.Width = ActiveCell.Width
       monimage.Name = Left(nf, Len(nf) - 4)
       Cells(lig + 1, col) = Left(nf, Len(nf) - 4)
       col = col + 1
       If col = 5 Then col = 1: lig = lig + 2
     End If
     On Error GoTo 0
     nf = Dir
  Loop
End Sub

JB

Merci JB, ça me convient, je vais pouvoir me débrouiller avec ton code

Merci encore

 

[BOISGONTIER]

Re : Insertion d'images

Voir PJ

JB

 

[pierrejean]

Re : Insertion d'images

Re
Arf : A la bourre moi
Salut JB

Vois si cela te convient
nb : ligne a adapter

image.Height = [COLOR=blue]125[/COLOR]

normalement le rapport hauteur/largeur de la photo doit etre respecté

 

[Infogroup]

Re : Insertion d'images

Re
Arf : A la bourre moi
Salut JB

Vois si cela te convient
nb : ligne a adapter

image.Height = [COLOR=blue]125[/COLOR]

normalement le rapport hauteur/largeur de la photo doit etre respecté

Merci également à toi Pierre Jean, c'est sympa de têtre occupé de mon pb, et merci aussi à JB dont la compétence est une référence.

Chapeau bas à vous deux

Cordialement

Infogroup