XL 2016 Probleme positionnement image

[WILFRIED]

Bonjour,

J'ai creer un code me permettant de placer des images (blason de tir a l'arc) automatiquement.

ActiveCell.Offset(2, 0).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\img\trispot.jpg").Select

au prealable je selectionne ma cellule

Sur mon PC les images ce placent bien aux bons endroits.

Sur le PC du club (excel 2007) les images ce placent toutes les unes sur les autres...

Je ne comprend pas l'erreur?

Si une ame charitable pouvait m'aider car notre competition est demain.

Merci

wilfried

 

[Patrice33740]

Bonjour,

Une méthode générique :

Option Explicit
Sub Inserer_une_image()
' Insère une image dans une cellule
'
Dim shr As Excel.ShapeRange
Dim dst As Range
Dim repImages$
Dim nomImage$
  repImages = ThisWorkbook.Path & "\"  ' Dossier contenant les images (à adapter)
  nomImage = "MonImage.jpg"  ' Nom de l'image.jpg (à adapter)
  Set dst = Worksheets("Feuil1").Range("A2")  ' Cellule destination (à adapter)
  ' Vérifier l'existence de l'image ...
  If Dir(repImages & nomImage) <> "" Then
  ' ... si oui :
  ' - inserer l'image sur la feuille et la nommer
  Set shr = dst.Parent.Pictures.Insert(repImages & nomImage).ShapeRange
  shr.Name = Mid(nomImage, 1, InStrRev(nomImage, ".") - 1)
  ' - positionner l'image sur la cellule destination
  shr.Left = dst.Left
  shr.Top = dst.Top
  ' - adapter l'image à la taille de la cellule
  shr.LockAspectRatio = msoFalse
  shr.Width = dst.Width
  shr.Height = dst.Height
  Else
  ' ... sinon : message d'information
  MsgBox "L'image " & nomImage & " n'existe pas dans le dossier :" & vbCrLf & _
  repImages, vbCritical
  End If

End Sub

 

[WILFRIED]

Bonjour,

Merci pour cette solutions.

Je vais donc adapter mon code.

Cordialement,

Wilfried

 

[Patrice33740]

Re,

Avec le VBA, il faut absolument éviter d'employer .Select (c'est une des première source d'ennuis).