Insertion image selon critère

Version imprimable

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 :

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
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

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".
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.

Salut,

à la place de ligne mets activecell.row. Cela te donne la ligne ou tu te trouve.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
         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" & activecell.row
                positionY = "E" & activecell.row
            'End If
       ElseIf Worksheets("Portables de Prêts").Cells(Ligne, 3).Value = "DISPONIBLE" Then
            Fichier = "F:\Boulot\feu_vert.png"
            positionX = "E" & activecell.row
            positionY = "E" & activecell.row
         End If

et au pire, si tu as toujours un decalage de 1, tu remplace par

Code:

len(activecell.row,50)+1

Bon courage

02/11/2010, 19h45
lumpys

Activecell.row ne fonctionne pas.

Je ne comprends pas len(activecell.row,50)+1
à quoi cela correspond? Excel ne semble pas reconnaitre cette écriture.
02/11/2010, 22h18
chickenhands

Dsl pour le len je l'avais inversé avec le left

Tu veux bien recuperer le numero de ligne pour donner la position de ton image?Tu te trouve en c3 et tu veux donc recuperer le 3?
dans ce cas utilise activecell.row

pour continuer a utiliser ta variable ligne fais comme ceci pour calculer la variable

Code:

ligne= Left(ActiveCell.Row, 10)

Avec ceci, ligne=3
apres, peut importe la ligne ou tu te trouve, cela ramenera le numero de ligne.
Je n'ai pas testé ta boucle, je ne peux donc pas te dire si elle ramene la bonne variable ou s'il y a toujours un décalage. s'il persiste, rajoute +1 apres la parenthese.
04/11/2010, 12h38
lumpys

J'ai finalement réussit à régler mon problème de décalage en changeant de place la ligne où je recherchais la position.

Merci pour les réponses, j'ai gardé activecell.row.