Problème insertion image

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Je suis nouveaux sur ce forum et j'espère ben que vous allez pouvoir m'aider :D

J'ai une macro qui me permet d'importer des images sur une feuille excel, elle fonctionne très bien sur une feuille mais dès que je veux l'utiliser sur une autre feuille (en changeant bien sur l'appel de la feuille excel) elle ne fonctionne plus :weird: !!!

L'erreur est la suivante :
Pièce jointe 405601

Le code s'arrête sur cette ligne :

Code:

Set img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

Voici mon code :

Code:

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
33
34
35
36
37
38
39
40
41
42
43
Sub bp_add_photo_R1()
 
 'variable select photo
        Dim fd As Object
        Dim SelectedFile As Variant
        Dim repertoire
        Dim rep As Integer
        Dim dir_photo
        Dim img
                        Worksheets("Hazard_pictures").Activate
 
                        rep = MsgBox("Add a Hazard Picture ?", vbYesNo + vquestion)
 
                        If rep = vbYes Then
 
                                                If Application.Dialogs(xlDialogInsertPicture).Show Then
                                                    dir_photo = "B4"
                                                 End If
 
                                       Set Emplacement = Worksheets("Hazard_pictures").Range(dir_photo)
                                       Set img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
                                            If img.ShapeRange.Width > img.ShapeRange.Height Then
                                            img.ShapeRange.Width = 210
                                            End If
                                            If img.ShapeRange.Height > 140 Then
                                            img.ShapeRange.Height = 140
                                            End If
 
                                        With img.ShapeRange
                                            .Name = "1"
                                            .LockAspectRatio = msoTrue
                                            .Left = Emplacement.Left + (Emplacement.Width - img.Width) / 2
                                            .Top = Emplacement.Top + (Emplacement.Height - img.Height) / 2
                                        End With
 
 
 
                        Else
                            MsgBox "Interrupted picture insertion"
                        End If
 
End Sub

Si vous pouvez m'aider je vous en serais reconnaissant...

Merci pour votre aide :D

22/08/2018, 13h18
patricktoulon

re

re
bonjour
sans parler du reste du code qui fait apel a une collection d'object qui n'est pas appropriée!!;)
ta ligne c'est ceci:

Code:

Set img = ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
22/08/2018, 13h29
PjonathanG

Merci pour ta réponse,

Ça fonctionne je n'ai plus d'erreur.

Par contre j'ai 2 petites questions :
- quand tu dis que je fais appel a une collection d'objet qui n'est pas approprié, est ce que tu peux préciser mes erreurs ?
- pourquoi mon code (certainement mauvais :oops:) fonctionnait sur une feuille et pas l'autre ?8O

Désolé pour mes questions mais je débute en codage... :oops:

Merci encore de ton aide.
22/08/2018, 13h39
patricktoulon

re

re
la collection a la quelle tu fait apel =ActiveSheet.DrawingObjects ors la collection ActiveSheet.pictures qui est plus appropriée

pour le reste du code j'ai un doute sur le fait que tu redimentionne ton image et tu la place vers "B4" par un calcul
je suis pas sur que les dim correspondent a moins que tu ai modifié les dimentions de cellules
chez moi l'image se retrouve en haut a gauche (en A1 quoi)
22/08/2018, 13h46
PjonathanG

Effectivement j'adapte la dimension de la cellule après.

Encore merci pour ton aide en tout cas !:)

voila ton code nétoyé et simplifié

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub bp_add_photo_R1()
'variable select photo
    Dim fd As Object, SelectedFile As Variant, repertoire, rep%, dir_photo$, img As Picture
 
    rep = MsgBox("Add a Hazard Picture ?", vbYesNo + vquestion)
    If rep = vbYes Then
        With Worksheets("Hazard_pictures")
            .Activate
            If Application.Dialogs(xlDialogInsertPicture).Show Then dir_photo = "B4"
            Set Emplacement = .Range(dir_photo)
            With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
                If .Width > .Height Then .Width = 210
                If .Height > 140 Then .Height = 140
                .Name = "1"
                .ShapeRange.LockAspectRatio = msoTrue
                .Left = Emplacement.Left + (Emplacement.Width - .Width) / 2
                .Top = Emplacement.Top + (Emplacement.Height - .Height) / 2
            End With
        End With
    Else
        MsgBox "Interrupted picture insertion"
    End If
End Sub