VBA - Inserter une image avec rotation et positionnement Résolu/Fermé

Question

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

Frenchie83 · Answer

Bonjour
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

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

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

Bendit0044 · Answer

Merci Frenchie83 et cs_Le Pivert. AU final j'ai utilisé le second code.

Merci encore.

cs_Le Pivert · Answer

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

VBA - Inserter une image avec rotation et positionnement

5 réponses

Discussions similaires