Bonjour,
J'ai réalisé le code suivant afin que selon le critère de la 3ème colonne, un feu s'affiche dans la colonne 5 de la ligne :
J'ai un problème à la ligne 5, l'image s'affiche dans la colonne 5 mais à la ligne 4. Il n'y a qu'à cette ligne que cela se produit, les autres fonctionnent correctement. En débogage, on s'aperçoit que positionX est resté à "E4".
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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76 Private Sub Worksheet_Activate() 'Déclaration des variables Dim objFeuille As Worksheet, objPict As Picture, img As Object Dim Fichier As String Dim positionX As String Dim positionY As String Dim Datejour, Ligne, essai 'Déclaration des objets Set objFeuille = ActiveSheet 'Suppression des images existantes For Each img In Worksheets("Portables de Prêts").Shapes img.Delete Next 'Prêts moins 3 semaines Range("A3").Select Ligne = 3 Do While Not IsEmpty(ActiveCell) Ligne = Ligne + 1 Selection.Offset(1, 0).Select 'Définition de la position et de l'image en fonction de la valeur If Worksheets("Portables de Prêts").Cells(Ligne, 3).Value = "EN REPARATION" Or Worksheets("Portables de Prêts").Cells(Ligne, 3).Value = "INDISPONIBLE" Then Fichier = "F:\Boulot\feu_rouge.png" 'If Ligne = 5 Then ' positionX = "E5" ' positionY = "E5" ' GoTo 1 'Else positionX = "E" & Ligne positionY = "E" & Ligne 'End If ElseIf Worksheets("Portables de Prêts").Cells(Ligne, 3).Value = "DISPONIBLE" Then Fichier = "F:\Boulot\feu_vert.png" positionX = "E" & Ligne positionY = "E" & Ligne End If 'Position de l'objet Set objPict = objFeuille.Pictures.Insert(Fichier) With objPict .Left = Range(positionX).Left .Top = Range(positionY).Top End With Loop 'Prêts de 3 mois à 12 mois Range("A15").Select Ligne = 15 Do While Not IsEmpty(ActiveCell) Ligne = Ligne + 1 Selection.Offset(1, 0).Select 'Définition de la position et de l'image en fonction de la valeur If Worksheets("Portables de Prêts").Cells(Ligne, 3).Value = "EN REPARATION" Or Worksheets("Portables de Prêts").Cells(Ligne, 3).Value = "INDISPONIBLE" Then Fichier = "F:\Boulot\feu_rouge.png" positionX = "E" & Ligne positionY = "E" & Ligne ElseIf Worksheets("Portables de Prêts").Cells(Ligne, 3).Value = "DISPONIBLE" Then Fichier = "F:\Boulot\feu_vert.png" positionX = "E" & Ligne positionY = "E" & Ligne End If 'Position de l'objet Set objPict = objFeuille.Pictures.Insert(Fichier) With objPict .Left = Range(positionX).Left .Top = Range(positionY).Top End With Loop End Sub
Est-ce quelqu'un voit ce qui ne fonctionne pas correctement ? Ce qui est bizarre, c'est que je n'ai pas ce problème aux autres lignes. J'ai essayé de forcer lorsqu'il est à cette ligne mais il reste sur E4.
Merci d'avance pour votre aide.
Partager