Bonjour à toutes & à tous,

Je vous expose mon problème :

J'ai un tableau excel avec en colonne A une liste des personnes ; en colonne H le taux de fréquence (Tf) de ces personnes.

La liste des Tf commence en H3 et peut aller jusqu'à H10 ou H15... une zone indéfinie. J'ai donc sélectionner la plage H3:H65536 comme zone "Tf".

La cellule Q10 est une valeur maxi du Tf au-delà de laquelle je considère comme mauvais les résultats.
La cellule D18 est une l'objectif annuel de ces personnes.

J'insére une image en fonction de la valeur du Tf et là j'ai trouver un code VBA qui marche à merveille car l'image est redimensionnée à la taille de la cellule...bref.
L'insertion de l'image doit ce faire dans la colonne M correspondant à la ligne du Tf analysé.

Par contre je ne comprend pas pourquoi mon code effectue cette boucle à l'infinie, pas dans la colonne M de la ligne et surtout pourquoi il insert une image alors que la valeur des lignes hors tableau sont égales à 0.

Help !!!!



Voici le code en question :

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
77
78
79
80
81
82
Private Sub Command_meteo_Click() 
 
Set r = Range("Tf") 
 
For n = Range("H3") To r.Rows.Count 
 
'paramètre pour insertion image en fonction de la valeur 
Dim Fichier As String 
Dim objImg As Object 
Dim Emplacement As Range 
 
 
 
If r.Cells(n, 8) = 0 Then 
End If 
 
 
If r.Cells(n, 8) > Range("Q10") Then 
r.Cells(n, 8).Offset(0, 5).Activate 
 
Fichier = "C:\Documents and Settings\a.narbaits-jaureguy\Mes documents\Mes images\image3.gif" 
Set objImg = ActiveSheet.Pictures.Insert(Fichier) 
Set Emplacement = ActiveCell 
Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count) 
 
With objImg.ShapeRange 
.LockAspectRatio = msoFalse 
.Left = Emplacement.Left 
.Top = Emplacement.Top 
.Height = Emplacement.Height 
.Width = Emplacement.Width 
End With 
 
End If 
 
 
 
 
If Range("D18") < r.Cells(n, 8) < Range("Q10") Then 
r.Cells(n, 8).Offset(0, 5).Activate 
 
Fichier = "C:\Documents and Settings\a.narbaits-jaureguy\Mes documents\Mes images\image2.gif" 
Set objImg = ActiveSheet.Pictures.Insert(Fichier) 
Set Emplacement = ActiveCell 
Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count) 
 
With objImg.ShapeRange 
.LockAspectRatio = msoFalse 
.Left = Emplacement.Left 
.Top = Emplacement.Top 
.Height = Emplacement.Height 
.Width = Emplacement.Width 
End With 
 
End If 
 
 
 
 
If Range("D18") > r.Cells(n, 8) Then 
r.Cells(n, 8).Offset(0, 5).Activate 
 
Fichier = "C:\Documents and Settings\a.narbaits-jaureguy\Mes documents\Mes images\image1.gif" 
Set objImg = ActiveSheet.Pictures.Insert(Fichier) 
Set Emplacement = ActiveCell 
Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count) 
 
With objImg.ShapeRange 
.LockAspectRatio = msoFalse 
.Left = Emplacement.Left 
.Top = Emplacement.Top 
.Height = Emplacement.Height 
.Width = Emplacement.Width 
End With 
 
End If 
 
 
 
 
Next n 
End Sub