Gestion d'affichage d'image dans cellule

Le
Alex
Bonjour à tous,

Je rencontre un problème de positionnement d'affichage d'image sur une
feuille, et m'en explique.
Depuis un formulaire vba, l'utilisateur peut selectionner une photo.
Ce la rappatrie automatiquement le chemin d'accès.
Quand la personne valide les informations saisies se positionne sur
une feuille sur la ligne n+1 (creation d'une nouvelle ligne), j'ai
écrit ceci :

nbligne = Range("B1").CurrentRegion.Rows.Count
i = nbligne + 1
If Me.CheminPhot <> "" Then
Cells(i, 1).Value = Me.CheminPhot
img = Cells(i, 1).Value
Set monimage = ActiveSheet.Pictures.Insert(img)
monimage.Height = ActiveCell.Height
monimage.Width = ActiveCell.Width
end if

Cela fonctionne très bien, à un détail près l'image se positionne
toujours en A1 et non sur ma ligne i.

Quelqu'un aurait il une idée de solution à mon problème.

Merci par avance de votre aide.
Cordialement.
Alex
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #25316032
Bonjour,

Ajoute ces 2 lignes à cette section de ta procédure :

Set monimage = ActiveSheet.Pictures.Insert(img)
monimage.Height = ActiveCell.Height
monimage.Width = ActiveCell.Width
monimage.Left = ActiveCell.Left '<<<==== monimage.Top = ActiveCell.Top '<<<====

MichD
---------------------------------------------------------------
Alex
Le #25316072
Bonjour,

Merci pour la réponse. Malheureusement l'image se positionne toujours
en A1, j'ai également tenté de remplacé ActiveCell par Cells(i,1) :

Set monimage = ActiveSheet.Pictures.Insert(img)
monimage.Height = Cells(i, 1).Height
monimage.Width = Cells(i, 1).Width

monimage.Left = Cells(i, 1).Left
monimage.Top = Cells(i, 1).Top

Mais également elle se positionne en A1.

Merci d'avance de votre aide.
Cordialement.
Alex
MichD
Le #25316092
Il n'y a pas de raison pourquoi ceci ne devrait pas fonctionner....

'----------------------------------------------------
Sub test()
Dim i As Long, MonImage As Picture
Dim Img As String
With Worksheets("Feuil1") 'Adapte le nom de la feuille
i = .Range("A65536").End(xlUp).Row + 1
If Me.CheminPhot <> "" Then
.Range("A" & i).Value = "toto" ' Me.CheminPhot
Img = .Range("A" & i).Value
Set MonImage = .Pictures.Insert(Img)
MonImage.ShapeRange.LockAspectRatio = msoFalse
With .Range("A" & i)
MonImage.Height = .Height
MonImage.Width = .Width
MonImage.Top = .Top
MonImage.Left = .Left
End With
End If
End With
End Sub
'----------------------------------------------------


MichD
---------------------------------------------------------------
Alex
Le #25316402
Re :
J'ai testé et cela bloque sur Set MonImage = .Pictures.Insert(Img)
Avec la souris en me positionnant sur la ligne, apparait le message suivant :
MonImage = Nothing, et le (img) apporte bien le l'adresse du lien
Sur le message "Debogage" :

Erreur d'excution 1004
Impossible de lire propriété Insert de la classe Pictures

Si cela avait fonctionné, est que cela aurait voulu dire qu'il faille que je corrige mes lignes avec : cells(i,X) par des Range("A" & i) ?

Merci d'avance pour ta réponse.
Bien cordialement.
Alex
MichD
Le #25316412
Ceci a été testé avec Excel 2010 et cela fonctionne très bien.

Cette ligne a été désactivée, car elle fait référence à un contrôle
de ton formulaire que je n'ai pas...
'If Me.CheminPhot <> "" Then

' pour cette ligne de code :
.Range("A" & i).Value = "toto" ' Me.CheminPhot
Observe bien, j'ai mis "toto" car encore une fois
le contrôle "Me.CheminPhot" n'existe pas dans mon
environnement. À modifier dans ton application!

'Ceci est un fichier image sur mon ordinateur
Img = "C:UsersMichDPicturesIMG.bmp"

Que tu utilises "Cells()" ou "Range" n'a pas d'importance
pourvu que tu fasses référence à la cellule de la feuil1
ou celle que tu as utilisée dans ton application.

Quand cette ligne de code tombe en erreur, quelle est la valeur
de la variable "Img" ? Est-ce que le chemin et le nom de l'image
+ extension du fichier existe réellement?

'-------------------------------------------------------
Sub test()
Dim i As Long, MonImage As Picture
Dim Img As String
With Worksheets("Feuil1") 'Adapte le nom de la feuille
i = .Range("A65536").End(xlUp).Row + 1
'If Me.CheminPhot <> "" Then
.Range("A" & i).Value = "toto" ' Me.CheminPhot
Img = "C:UsersMichDPicturesIMG.bmp" ' .Range("A" & i).Value
Set MonImage = .Pictures.Insert(Img)
MonImage.ShapeRange.LockAspectRatio = msoFalse
With .Range("A" & i)
MonImage.Height = .Height
MonImage.Width = .Width
MonImage.Top = .Top
MonImage.Left = .Left
End With
' End If
End With
End Sub
'-------------------------------------------------------


MichD
---------------------------------------------------------------
Alex
Le #25317502
La cela fonctionne, je n'avais sans doute pas bien fait les
adaptations de la macro.
Merci beaucoup.
Alex
Publicité
Poster une réponse
Anonyme