VBA - Inserter une image avec rotation et positionnement
Résolu/Fermé
Bendit0044
-
3 sept. 2015 à 07:44
cs_Le Pivert Messages postés 7883 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 18 mars 2023 - 4 sept. 2015 à 07:57
cs_Le Pivert Messages postés 7883 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 18 mars 2023 - 4 sept. 2015 à 07:57
A voir également:
- VBA - Inserter une image avec rotation et positionnement
- Frédéric cherche à faire le buzz sur les réseaux sociaux. il a ajouté une image de manchots sur une image de plage. retrouvez l'image originale de la plage. que cachent les manchots ? ✓ - Forum Windows
- Rotation ecran windows - Guide
- Recherche par image - Guide
- Erreur 1004 vba ✓ - Forum VB / VBA
- Positionner une image html ✓ - Forum HTML
5 réponses
Frenchie83
Messages postés
2239
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
28 janvier 2023
335
3 sept. 2015 à 10:56
3 sept. 2015 à 10:56
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
cs_Le Pivert
Messages postés
7883
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 mars 2023
724
3 sept. 2015 à 12:26
3 sept. 2015 à 12:26
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
cs_Le Pivert
Messages postés
7883
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 mars 2023
724
3 sept. 2015 à 12:28
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
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
4 sept. 2015 à 07:29
Merci Frenchie83 et cs_Le Pivert. AU final j'ai utilisé le second code.
Merci encore.
Merci encore.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_Le Pivert
Messages postés
7883
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 mars 2023
724
4 sept. 2015 à 07:57
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:
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