VBA - Inserter une image avec rotation et positionnement

Résolu/Fermé

Bendit0044 - 3 sept. 2015 à 07:44
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 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
Image iso - Guide
Rotation video - Guide
Comment agrandir 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 lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
3 sept. 2015 à 10:56

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 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
3 sept. 2015 à 12:26

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 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
3 sept. 2015 à 12:28

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 mercredi 22 avril 2015 Statut Membre Dernière intervention 4 novembre 2015
4 sept. 2015 à 07:29

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 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
4 sept. 2015 à 07:57

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

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

VBA : Range avec références variables..

Comment enlever le rouge sur la photo svp ?

ouverture d'un fichier excel à partir d'un code VBA

Discussions similaires

Newsletters