VBA - Inserter une image avec rotation et positionnement

Résolu

Bendit0044 -
cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention - 4 sept. 2015 à 07:57

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

A voir également:

VBA - Inserter une image avec rotation et positionnement
Rotation ecran windows - Guide
Rotation video - Guide
Image iso - Guide
Légender une image - Guide
Acronis true image - Télécharger - Sauvegarde

5 réponses

Réponse 1 / 5

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

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

Réponse 2 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

Réponse 3 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

Réponse 4 / 5

Bendit0044 Messages postés 7 Date d'inscription Statut Membre Dernière intervention

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

Réponse 5 / 5

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

Discussions similaires

PIX

Dechiffrer une image caché

Retrouver l'image originale après avoir fait des modifications ?

Votre réponse

Discussions similaires