Discussion :

[manuseverine]

Bonjour,

J'ai inséré un bouton, et j'aimerais que quand je clic dessus, ça m'ouvre la fenêtre d'insertion image, et quand j'ai choisis le chemin de mon image et que je la valide ; que ça l'insert dans la cellule active.

Est-ce possible ?

Je sais que pour ouvrir un lien, on fait comme ça, mais je ne sais pas comment faire pour la récupérer en fonction de la cellule active

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.FollowHyperlink "chemin fichier"

[manuseverine]

je crois que j'ai réussi (grâce au FAQ) mais il reste un petit soucis que je n'arrive pas à résoudre. Je vous donne d'abord 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
31
 Sub CommandButton1_Click()
    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 = ActiveCell
 
        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

Ca marche mais, au lieu de me supprimer l'image qu'il y aurait dans la cellule avant d'insérer la nouvelle, ça me supprime toutes les images de ma feuil.

Comment faire pour qu'il ne supprime que les photos existantes de la cellule active uniquement ?

[fring]

Bonjour,

Premièrement je supprimerais cette ligne dans ton code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Name = "Cible"

Vu que tu vas insérer plusieurs images dans différentes cellules, tu ne pourras pas toutes les nommer "Cible".

Ensuite pour supprimer l'image située dans la cellule active, tu peux faire comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
For Each ShapeObj In ActiveSheet.Shapes
    If CInt(ShapeObj.Left) = CInt(ActiveCell.Left) And CInt(ShapeObj.Top) = CInt(ActiveCell.Top) Then
        ShapeObj.Delete
        Exit For
    End If
Next ShapeObj

[manuseverine]

je te remercie beaucoup Fring

Par contre, je te donne mon code après avoir apporté tes modifs et le problème (je suppose que c'est moi qui est dû commettre un erreur) c'est que maintenant si j'ai une image, par exemple en D3, si je me positionne dessus pour avoir cette cellule comme active et bien quand je clique sur le bouton pour insérer la photo elle ne se mets jamais là ou il y en a déjà une, elle ne l'efface pas, elle se mets dans la cellule d'à côté ???
:

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
 
    Sub CommandButton1_Click()
    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 CInt(ShapeObj.Left) = CInt(ActiveCell.Left) And CInt(ShapeObj.Top) = CInt(ActiveCell.Top) Then
        ShapeObj.Delete
        Exit For
    End If
        Next ShapeObj
 
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        'Définit l'emplacement de l'image
        Set Emplacement = ActiveCell
 
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
        With Img.ShapeRange
            .LockAspectRatio = msoFalse
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With
 
    Else
        MsgBox "Insertion d'image interrompue."
    End If
 
End Sub

[fring]

Le problème est que lorsqu'une image est insérée dans la cellule, en cliquant dessus, tu ne sélectionnes pas la cellule mais l'image.

Pour rendre la cellule active tu dois sélectionner une cellule vide avoisinante et activer la cellule sous l'image via les flèches, ce qui n'est pas très pratique...

là je manque un peu d'inspiration mais une solution éventuelle serait de passer par une boîte de dialogue dans laquelle tu indiques l'adresse de la cellule de destination

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 CommandButton1_Click()
Dim Celref As String, Emplacement As Range, Img As Object, ShapeObj As Shape
 
Celref = InputBox("Dans quelle cellule voulez-vous insérer l'image ?" & Chr(10) & "(Indiquez l'adresse de la cellule de destination, par exemple E5)")
 
'définit l'emplacement de l'image
Set Emplacement = Range(Celref)
 
'Boucle pour supprimer l'ancienne image
For Each ShapeObj In ActiveSheet.Shapes
    If CInt(ShapeObj.Left) = CInt(Emplacement.Left) And CInt(ShapeObj.Top) = CInt(Emplacement.Top) Then
        ShapeObj.Delete
        Exit For
    End If
Next ShapeObj
 
If Application.Dialogs(xlDialogInsertPicture).Show Then
    Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
    With Img.ShapeRange
        .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

[manuseverine]

je te remercie beaucoup, je n'avais pas pensé à ça

Le problème est que lorsqu'une image est insérée dans la cellule, en cliquant dessus, tu ne sélectionnes pas la cellule mais l'image

c'est logique quand on y réfléchit et tellement évident que je n'y avais pas pensé.

Je te remercie en tout cas pour ta solution intermédiaire