Discussion :

[wabo67]

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

[ouskel'n'or]

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+

[wabo67]

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

[wabo67]

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