Macro pour Image

Bonjour,

Comment faire par une Macro :

- Faire pivoter une image
- Redimentionner une image
- Placer cette image rectifiée dans une cellule précise

Merci de m'aider

Bonjour,

comme toi, je ne sais pas... mais j'ai fais un enregistrement de macro et après visualisation j'ai ca. Ca peut déjà t'aider je pense...

Code:

---

1 2 3 4 5 6 7 8 9

'Je selectionne mon image ActiveSheet.Shapes("Picture 1").Select 'Je la tourne de 90° vers la gauche Selection.ShapeRange.IncrementRotation -90# 'Je la retourne encore de 90° vers la gauche Selection.ShapeRange.IncrementRotation -90# 'Je change sa taille (je te laisse chercher la correspondance des échelle. Dans le cas présent vu comme je l'ai agrandi, je pense que le 1,7 correspond à 1,7 fois sa taille. Une ligne largeur et une ligne hauteur.. Selection.ShapeRange.ScaleWidth 1.7, msoFalse,msoScaleFromBottomRight Selection.ShapeRange.ScaleHeight 1.7, msoFalse,msoScaleFromBottomRight

---

Pour la mettre dans une case par contre je sais pas...

Perso je sais pas faire, mais en utilisant l'enregistreur de macros, tu apprendrais beaucoup de choses ;)

Et la commande Recherche est ton amie :)

Pour l'image dans la cellule, c'est impossible dans Excel, tu peux juste faire en sorte que le coin haut gauche de ton image corresponde au coin haut gauche d'une cellule (en gros tu peux pas faire un fond de celulle avec une image)

Penses a utiliser l'enregistreur de macro

- Faire pivoter une image

Code:

---

1 2 3

ActiveSheet.Shapes("Picture 1").Select Selection.ShapeRange.IncrementRotation 90#

---

- Redimentionner une image

Code:

---

1 2 3 4

ActiveSheet.Shapes("Picture 1").Select Selection.ShapeRange.ScaleHeight 0.67, msoFalse, msoScaleFromBottomRight Selection.ShapeRange.ScaleWidth 0.67, msoFalse, msoScaleFromTopLeft

---

- Placer cette image rectifiée dans une cellule précise

Code:

---

1 2 3 4

ActiveSheet.Shapes("Picture 1").Select Selection.ShapeRange.IncrementLeft 303# Selection.ShapeRange.IncrementTop 108.75

---

Pour plus de précision utilises :f1:

Bonjour,

Merci de vos réponses, je vais tester

et je reviens pour d'autres explications

@ +

Re Bonjour,

Le pivotage de l'image = OK

Pour le redimentionnement c'est OK, mais l'attribut
proportionnel reste coché et l'image est bonne en
hauteur mais plus en largeur

Autre chose quand j'ai bidouillé l'image, je la copie dans
une aure feuille. Et la, le problème, c'est que la macro incrémente
le nom de l'image de ("Picture 1") a ("Picture 2") et ainsi de suite !

Comment éviter cela ?

Merci de vos aides

Placer une image pivoter à 90° redimensionnée à la taille de la cellule de destination

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Dim Image As Object Dim Position As Range Set Position = Range("...") Set Image = ActiveSheet.Shapes("...") With Image .LockAspectRatio = msoTrue .Left = Position.Left .Top = Position.Top .Height = Position.height .Widht = Position. widht .Rotation = 90# End With

---

C'est le plus simple que j'ai trouvé...
Bye

Le plus simple pour éviter l'incrémentation d'un numéro aléatoire est que tu copies les images sur une feuille et que tu les renommes directement dans la barre d'outil en haut à gauche.
Ainsi quand tu la copies et tu la colles elle garde le même nom, donc plus de problème d'incrémentation de numéro;
Si tu ne veux pas que l'onglet avec les images soit visible, tu peux le masquer et le faire apparaître avec une userform.
c'est une propriété que tu peux modifier directement dans ta feuille (xlsheethidden ou xlsheetvisible)
et avec l'ouverture de ta userform tu inscris :

Citation:

---

Worksheets("...").Visible = True

---

Voilà j'espère avoir été claire

Bonjour PascGuil,

Merci pour les infos

OK pour le retournement de l'image
Par contre l'image ne s'adapte pas a la dimention de la cellule
mais si on change les dimentions de la cellule, celles de l'image
changent aussi.

Je n'est pas besoin que mon image soit aux dimentions d'une
cellule mais avoir une talle précise en l'occurence, faire :
- en hauteur 3.39 Cm
- en largeur 5.42 Cm

Car je ne souhaite pas forcément garder les proportions d'origine

Après, je la coupe et la colle dans une autre feuille

bonsoir


Remplace

Code:

---

.LockAspectRatio = msoTrue

---

par

Code:

---

.LockAspectRatio = msoFalse

---

bonne soirée
michel

Merci à tous,

C'est OK

@ +