[XL-2003] Problème de copier-coller d'images en fonction de critères [Résolu]

[SkyCorp]

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 :

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 ?

[Daniel.C]

Bonjour,

Ca doit dépendre de tes données. Il est possible que :

Code :

oSheet.UsedRange.Row + 12

soit plus grand que :

Code :

oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count

auquel cas tu débranches directement en fin de macro.

Ajoute :

Code :

1
2
MsgBox oSheet.UsedRange.Row + 12
MsgBox oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count

avant la ligne 11 pour le vérifier.

[SkyCorp]

Etrangement, je viens de relancer mon fichier, sans rien changer et tout fonctionne à présent
Je l'avais pourtant relancé auparavant aussi. C'est à ne rien y comprendre. Peut-être le fait de relancer la machine a fait quelque chose.

En tout cas, merci Daniel de m'avoir signalé ce point, il y a un risque que ça déconne. Je vais corriger ça de suite.