Bonjour
J'essai d'insérer une image dans une zone donnée
Par contre il me fait une erreur et je n'arrive pas a trouver.
Voila ce que j'ai deja fait
Lancer l'application
Inserer une image
Erreur 1004
Si quelqu'un peut m'aider
Merci
Bonjour
J'essai d'insérer une image dans une zone donnée
Par contre il me fait une erreur et je n'arrive pas a trouver.
Voila ce que j'ai deja fait
Lancer l'application
Inserer une image
Erreur 1004
Si quelqu'un peut m'aider
Merci
Il serait bien que tu précises ta demande. Tout le monde n'ouvre pas les fichiers joints et l'absence de ton code n'est pas là pour t'aider
A+
Voila le code:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30 Private Sub CommandButton2_Click() 'insérer une photo dans la zone avant Dim Emplacement As Range Dim image As Object Dim ShapeObj As Object On Error GoTo fin: For Each ShapeObj In ActiveSheet.DrawingObjects ' boucle pour supprimer ancienne image If ShapeObj.Name = "image1" Then ActiveSheet.Shapes("image1").Delete Next ShapeObj Application.Dialogs(xlDialogInsertPicture).Show Set Emplacement = Range("B10:H30") Set image = ActiveSheet.DrawingObjects(10) With image.ShapeRange .Name = "image1" ' nommer l'image insérée ( pour la supprimer plus facilement ensuite ) .LockAspectRatio = msoTrue .Left = Emplacement.Left .Top = Emplacement.Top .Height = Emplacement.Height .Width = Emplacement.Width End With Exit Sub fin: If Err = 1004 Then MsgBox "Insertion d'image interrompue . " End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32 Sub InsertionImage() Dim Emplacement As Range Dim Img As Object Dim ShapeObj As Shape 'Boucle pour supprimer l'ancienne image For Each ShapeObj In ActiveSheet.Shapes If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete Next ShapeObj If Application.Dialogs(xlDialogInsertPicture).Show Then 'Définit l'emplacement de l'image Set Emplacement = Range("D3:E8") Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count) With Img.ShapeRange 'Nommer l'image insérée (Pour la supprimer plus facilement ensuite) .Name = "Cible" .LockAspectRatio = msoFalse .Left = Emplacement.Left .Top = Emplacement.Top .Height = Emplacement.Height .Width = Emplacement.Width End With Else MsgBox "Insertion d'image interrompue." End If End Sub
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager