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
A voir également:
- VBA - Inserter une image avec rotation et positionnement
- Rotation ecran windows - Guide
- Rotation video - Guide
- Légender une image - Guide
- Image iso - Guide
- Reduire taille image - Guide
5 réponses
Bonjour
Il suffit de décaler l'image après la rotation
A essayer et à adapter avec les bonnes valeurs
Cdlt
Il suffit de décaler l'image après la rotation
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.Left = Emplacement.Left - 38 Selection.Top = Emplacement.Top + 38
A essayer et à adapter avec les bonnes valeurs
Cdlt
Bonjour,
Essaie ceci:
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
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:
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