Bonjour,

Je souhaite copier un dessin de ma feuille Excel, dans toute cellule d'une colonne (sauf la première cellule) obéissant à un certain critère (dans mon cas, il s'agit d'un entier compris entre -2 et 1)

Pour le moment, je copie le dessin en copiant toute la cellule mais j'aimerai à présent ne copier que le dessin pour ne pas modifier le format de mes cellules.

Pour ce faire, j'ai rédigé le code suivant :
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
33
34
35
36
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oSheet As Excel.Worksheet  ' Feuille
Dim lLine As Long  ' Numéro de ligne
Dim Sh As Shape ' Images
Application.EnableEvents = False
 
Set oSheet = ThisWorkbook.Sheets("Synthèse")
' ou bien (si ça marche) : Set oSheet = ActiveSheet
 
' Pour chaque ligne de la feuille (on démarre ici de la ligne 13 ; si besoin, changer le "+1")
For lLine = oSheet.UsedRange.Row + 12 To oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count
' ou : For lLine = 13 To oSheet.UsedRange.Rows.Count
    ' On commence par supprimer les précédents dessins
    For Each Sh In oSheet.Shapes
        If Sh.TopLeftCell.Address = Range("H" & lLine).Address Then
            Sh.Delete
        End If
    Next
 
    If IsEmpty(Range("H" & lLine)) = False Then
        Select Case Range("H" & lLine).Value
            Case 1
                oSheet.Shapes("Image_soleil").Copy
            Case 0
                oSheet.Shapes("Image_nuage").Copy
            Case -1
                oSheet.Shapes("Image_pluie").Copy
            Case -2
                oSheet.Shapes("Image_orage").Copy
        End Select
        Range("H" & lLine).Select
        ActiveSheet.Paste
    End If
Next
Application.EnableEvents = True
End Sub
Dans ce code, j'ai donc 4 images, à afficher en fonction du critère souhaité (-2, -1, 0 ou 1).
Malheureusement, rien ne s'affiche. Une idée ?