Width d'un image adaptée à une cellule précise

Résolu
cs_JPh007 Messages postés 39 Date d'inscription mardi 12 août 2008 Statut Membre Dernière intervention 17 juillet 2012 - 28 déc. 2008 à 20:35
cs_JPh007 Messages postés 39 Date d'inscription mardi 12 août 2008 Statut Membre Dernière intervention 17 juillet 2012 - 29 déc. 2008 à 23:17
Bonjour,

Et pour commencer bonnes fêtes de fin d'année à ceux qui me liront:

J'essaye de construire un code qui me permet
- dans un premier temps de remplacer une image par une autre choisie par l'utilisateur,
- dans un deuxième temps de coller image dans la cellule A1
-dans un troisième et dernier temps d'adapter la taille de cette image à la cellule A1 ...

Voilà mes premiers bidouillages pour ce code:

Sub Change_Logo()

Dim sh As Shape
With ActiveSheet.Shapes("Picture 1").Delete '
' InsertPicture Macro
' Inserts a picture from a graphics file.
' Sets the View to (D)etail with SendKeys.
'  View choices [change last Sendkey Letter].
  SendKeys ("%L{LEFT}A")
  Application.Dialogs(xlDialogInsertPicture).Show

  Selection.Name = "Picture 1"

  Range("A1").Select
  Selection.shaperang.Width = ActiveCell.Width
  End With
End Sub

Le dernier temps ne fonctionne pas (message d'erreur: Propriété ou Méthode non gérée par cet objet) et je ne sais pas comment lui indiquer de coller l'image dans A1.
Merci pour votre aide.

4 réponses

cs_Orohena Messages postés 577 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 20 novembre 2010 4
28 déc. 2008 à 22:59
Bonjour jph007


Ton problème -outre la mauvaise orthographe du mot ShapeRange - vient surtout du fait que lorsque tu fais Selection.ShapeRange.Width = ActiveCell.Width, ce n'est plus l'image qui est dans ta sélection, mais la cellule A1, sélectionnée dans l'instruction précédente.

Peux-tu essayer le code ci-dessous ?





<hr />




Sub Change_Logo()

Dim sh As Shape
Dim action As Boolean
' InsertPicture Macro
' Inserts a picture from a graphics file.
' Sets the View to (D)etail with SendKeys.
'  View choices [change last Sendkey Letter].
  SendKeys ("%L{LEFT}A")
action = Application.Dialogs(xlDialogInsertPicture).Show
If action Then
    ActiveSheet.Shapes("Picture 1").Delete '
    With Selection
       .Name = "Picture 1"
       .Width = Range("A1").Width
       .Height = Range("A1").Height
    End With
End If
End Sub






<hr />
Amicalement
3
cs_JPh007 Messages postés 39 Date d'inscription mardi 12 août 2008 Statut Membre Dernière intervention 17 juillet 2012
29 déc. 2008 à 21:35
Salut,

Merci beaucoup pour ton aide ça marche impec,

Est ce qu'il est possible en plus de positionner cette nouvelle image exactement au-dessus de la cellule A1 ?
0
cs_Orohena Messages postés 577 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 20 novembre 2010 4
29 déc. 2008 à 22:00
Bien sûr, tu ajoutes
.Top = 0
.Left = 0
dans le bloc With / End With


Amicalement
0
cs_JPh007 Messages postés 39 Date d'inscription mardi 12 août 2008 Statut Membre Dernière intervention 17 juillet 2012
29 déc. 2008 à 23:17
 
Merci beaucoup,

Ca marche bien et quelque soit la taille initiale de l'image choisit par l'utilisateur...

Mes amitiés :)
0