Bonjour,

Je suis nouveau par ici et débutant en VBA.
Je viens vers vous pour un code sur lequel j'ai un peu buté, certes fonctionnel mais il ne me convient pas. Je trouve que l'on peut l'optimiser afin d'éviter notamment la vue des chargements sur le curseur certainement causé par la boucle du code qui me semble inutile. Vu que je sais quel ligne dois voir son image s'effacé/ce remplacer on doit pouvoir éviter de chercher parmi tous les Shapes.

Le but du code est d'insérer ou remplacer les logos de la colonne A sur la feuille active qui est la n°2 (Portefeuille) grâce aux url de la colonne E sur la feuille n°7 (API) seulement si les symboles (Colonnes C) sur les deux feuilles correspondent lors de l'insertion de ces symboles dans la cellule.

Les défauts actuels :
  1. C'est long à charger, on aperçoit les micro chargements au niveau du curseur.
  2. On voit l'url s'insérer furtivement avant de devenir l'image. Peut-on importer directement l'image dans la colonne A sans pour ce faire insérer au préalable l'url depuis la feuille 7 ?


Voci la macro :

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
 
Dim stopEvent
Dim CompareSymbole As Range
Dim PosLigne As Range
Dim Image As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
 
If stopEvent = 1 Then Exit Sub
 
stopEvent = 1
If Target.count > 1 Then
    stopEvent = 0
    Exit Sub
End If
 
 
If Target.Column = 3 Then 'Colonne Symbole
    Set PosLigne = Target.Offset(0, -2)
    If Target <> "" Then 'Si le symbole inséré est non vide
 
        Set CompareSymbole = Worksheets("API").Range("C:C").Find(Target, lookat:=xlWhole) 'Retrouve le Symbole dans la table API
 
        If Not CompareSymbole Is Nothing Then 'Si on retrouve le Symbole
 
 
            SupprimerImage
            PosLigne.Value = CompareSymbole.Offset(0, 2)
            Set Image = ActiveSheet.Pictures.Insert(PosLigne.Value)
            With Image
                .ShapeRange.LockAspectRatio = msoFalse
                .Width = PosLigne.Width - 10
                .Height = PosLigne.Height - 3
                .Top = Rows(PosLigne.Row).Top + 2
                .Left = Columns(PosLigne.Column).Left + 5
                .Placement = xlMoveAndSize
                .Locked = True
            End With
            PosLigne.Value = ""
 
 
 
        Else: PosLigne.Value = 0 'Si le symbole est introuvable, alors on met 0 en valeur pour l'image de mise en forme conditionnelle
        End If
    Else:
        PosLigne.ClearContents 'Si le symbole inséré est vide, alors on efface l'image et l'url
        SupprimerImage
    End If
End If
 
 
stopEvent = 0
End Sub
 
 
Sub SupprimerImage()
    For Each Image In ActiveSheet.Shapes
        If Image.TopLeftCell.Address = PosLigne.Address Then
            Image.Delete
            Exit Sub
        End If
    Next Image
End Sub
J'espère que j'ai assez bien détaillé les problèmes.
Je vous remercie par avance.