VBA - Inserter une image avec rotation et positionnement
Résolu
Bendit0044
-
cs_Le Pivert Messages postés 8437 Statut Contributeur -
cs_Le Pivert Messages postés 8437 Statut Contributeur -
Bonjour,
Je souhaite intégrer une image via une petite commande sur Excel. Dans un premier temps j'ai écris la macro suivante qui fonctionnait très bien, si l'image chargée est en format portrait. Le problème c'est que tout les images que je dois charger sont en format paysage. Je voudrais donc leur faire faire une rotation de 90° puis les centrer sur ma feuille.
Mon premier code était :
Sub InsertionImageDevis_Plan_GM()
Dim Emplacement As Range
On Error GoTo fin:
Application.Dialogs(xlDialogInsertPicture).Show
Set Emplacement = Range("B7:F45")
Selection.Left = Emplacement.Left
Selection.Top = Emplacement.Top
Selection.Height = Emplacement.Height
Selection.Width = Emplacement.Width
Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue"
End Sub
La feuille se positionnait sur le bon emplacement (de la colonne B à F) mais vu qu'elle n'est pas dans la bonne orientation elle ne prend que la moitié de la feuille, j'ai essayé plusieurs modif au code ci-dessus sans que cela ne fonctionne.
J'ai essayé la fonction "Selection.ShapeRange.IncrementRotation 90#" mais une fois mon image tournée, elle ne se positionne plus sur l'emplacement défini.
Auriez-vous une solution?
Merci d'avance,
Sylvain BOYER
Je souhaite intégrer une image via une petite commande sur Excel. Dans un premier temps j'ai écris la macro suivante qui fonctionnait très bien, si l'image chargée est en format portrait. Le problème c'est que tout les images que je dois charger sont en format paysage. Je voudrais donc leur faire faire une rotation de 90° puis les centrer sur ma feuille.
Mon premier code était :
Sub InsertionImageDevis_Plan_GM()
Dim Emplacement As Range
On Error GoTo fin:
Application.Dialogs(xlDialogInsertPicture).Show
Set Emplacement = Range("B7:F45")
Selection.Left = Emplacement.Left
Selection.Top = Emplacement.Top
Selection.Height = Emplacement.Height
Selection.Width = Emplacement.Width
Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue"
End Sub
La feuille se positionnait sur le bon emplacement (de la colonne B à F) mais vu qu'elle n'est pas dans la bonne orientation elle ne prend que la moitié de la feuille, j'ai essayé plusieurs modif au code ci-dessus sans que cela ne fonctionne.
J'ai essayé la fonction "Selection.ShapeRange.IncrementRotation 90#" mais une fois mon image tournée, elle ne se positionne plus sur l'emplacement défini.
Auriez-vous une solution?
Merci d'avance,
Sylvain BOYER
5 réponses
-
Bonjour
Il suffit de décaler l'image après la rotationApplication.Dialogs(xlDialogInsertPicture).Show Set Emplacement = Range("B7:F45") Selection.Left = Emplacement.Left Selection.Top = Emplacement.Top Selection.Height = Emplacement.Height Selection.Width = Emplacement.Width Selection.ShapeRange.IncrementRotation 90# Selection.Left = Emplacement.Left - 38 Selection.Top = Emplacement.Top + 38
A essayer et à adapter avec les bonnes valeurs
Cdlt -
Bonjour,
Essaie ceci:
Sub InsertionImageDevis_Plan_GM() Dim Emplacement As Range Dim I As Shape On Error GoTo fin: Application.Dialogs(xlDialogInsertPicture).Show Set Emplacement = Range("B7:F45") Selection.Left = Emplacement.Left - 10 Selection.Top = Emplacement.Top + 10 Selection.Height = Emplacement.Height Selection.Width = Emplacement.Width Selection.ShapeRange.IncrementRotation 90# Selection.Name = "Photo" Set I = Sheets("Feuil1").Shapes("Photo") I.Copy ActiveSheet.Shapes("Photo").Select Range("B7").Select ActiveSheet.Paste ActiveSheet.Shapes("Photo").Delete Exit Sub fin: If Err = 1004 Then MsgBox "Insertion d'image interrompue" End Sub
-
correction:
Sub InsertionImageDevis_Plan_GM() Dim Emplacement As Range Dim I As Shape On Error GoTo fin: Application.Dialogs(xlDialogInsertPicture).Show Set Emplacement = Range("B7:F45") Selection.Left = Emplacement.Left Selection.Top = Emplacement.Top Selection.Height = Emplacement.Height Selection.Width = Emplacement.Width Selection.ShapeRange.IncrementRotation 90# Selection.Name = "Photo" Set I = Sheets("Feuil1").Shapes("Photo") I.Copy ActiveSheet.Shapes("Photo").Select Range("B7").Select ActiveSheet.Paste ActiveSheet.Shapes("Photo").Delete Exit Sub fin: If Err = 1004 Then MsgBox "Insertion d'image interrompue" End Sub
-
Merci Frenchie83 et cs_Le Pivert. AU final j'ai utilisé le second code.
Merci encore. -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
Si tu veux mettre une autre image, il faudra supprimer celle qui s'y trouve déjà.
Voici le code:
Sub InsertionImageDevis_Plan_GM() Dim Emplacement As Range Dim I As Shape On Error GoTo fin: For Each I In ActiveSheet.Shapes If I.Name = "Photo" Then I.Delete Next I Application.Dialogs(xlDialogInsertPicture).Show Set Emplacement = Range("B7:F45") Selection.Left = Emplacement.Left Selection.Top = Emplacement.Top Selection.Height = Emplacement.Height Selection.Width = Emplacement.Width Selection.ShapeRange.IncrementRotation 90# Selection.Name = "Photo" Set I = Sheets("Feuil1").Shapes("Photo") I.Copy ActiveSheet.Shapes("Photo").Select Range("B7").Select ActiveSheet.Paste ActiveSheet.Shapes("Photo").Delete Exit Sub fin: If Err = 1004 Then MsgBox "Insertion d'image interrompue" End Sub
