Optimisation d'un code VBA pour remplacer une image en fonction d'une équivalence de cellule

**DeeJas** · 12/11/2022, 01h10

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 :

C'est long à charger, on aperçoit les micro chargements au niveau du curseur.
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.

**deedolith** · 12/11/2022, 02h30

Salut,

D'où proviennent les images ?
Si elles proviennent d'internet, ce temps de chargement est normal (temps de latence inhérente à internet).
Au pire tu peux désactiver les évènements, l'affichage et les alertes le temps que la fonction s'exécute:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
application.ScreenUpdating = false
application.EnableEvents = false
application.DisplayAlerts = false

Ne pas oublier de les réactiver une fois que tu as terminé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
application.ScreenUpdating = true
application.EnableEvents = true
application.DisplayAlerts = true

Sinon, pas grand-chose à redire sur ton code, sauf:
Vire les globales, tu n'en as pas besoin, et passes-les en local.
A quoi sert stopEvent ?
Evite les références dépendantes du contexte.

**DeeJas** · 12/11/2022, 13h23

Salut,

Merci pour la réponse rapide.
Les images sont des url qui sont déjà charger dans la table API lors de la recherche.

Je désactive déjà les évènements mais de manière "artisanale" grâce à la variable stopEvent que je viens de mettre en Static dans la Sub vu qu'elle ne me sert que pour l'événement.
J'utilise la variable pour désactiver l'événement en le quittant s'il est déjà en cours.
Dans ce cas, lorsque l'événement est déclenché, la variable stopEvent ne vaut pas 1, la procédure n'est donc pas quittée prématurément.
Lorsque la cellule sera modifiée, l'événement sera redéclenché mais cette fois-ci, stopEvent vaudra 1. La procédure s'arrêtera donc à la première ligne.

Evite les références dépendantes du contexte.

C'est à dire ?

Vire les globales, tu n'en as pas besoin, et passes-les en local.

Si tu parle des variable, je ne peut pas pour "PosLigne" et "Image" puisque je m'en sert dans les deux Sub.

**deedolith** · 12/11/2022, 14h33

Envoyé par DeeJas

Je désactive déjà les évènements mais de manière "artisanale" grâce à la variable stopEven

En claire tu shunte une gestionnaire d'évènement, mais tu ne désactive pas les évènements proprement dit.
De plus, ça ne sert à rien, VBA ne supporte pas le multi-thread, pendant qu'un code s'exécute, aucun autre ne peut s'exécuter en même temps.

Envoyé par DeeJas

Si tu parle des variable, je ne peut pas pour "PosLigne" et "Image" puisque je m'en sert dans les deux Sub.

Les paramètres, ça sert à quelque chose !!
Ce que tu as fait s'apparente plus à de la paresse qu'autre chose.

Envoyé par DeeJas

C'est à dire ?

L'utilisation du classeur / feuille / cellule active (ou pire, la sélection), est fortement dépendante des actions de l'utilisateur (un simple click et ça change).
En développement, on veut des certitudes. Voit pour t'en passer.

**DeeJas** · 25/11/2022, 01h36

Salut,

Ok pour les évènements je modifie ça.
Je ne comprend pas bien où tu veut en venir avec les paramètres. Je suis preneur si tu as une solution plus audacieuse.

Pour les actions oui c'est dépendant des actions de l'utilisateur mais totalement voulu.

**DeeJas** · 05/12/2022, 15h23

UP'

Je ne comprend malheureusement pas comment je peut optimiser le code à ce stade.

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
Dim PosLigne As Range
Dim Image As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With
 
If Target.Count > 1 Then
    With Application
        .Undo
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    Exit Sub
End If
 
If Target.Column = 3 Then 'Colonne Symbole
    Set PosLigne = Target.Offset(0, -2)
    SupprimerImage
    If Target <> "" Then 'Si le symbole inséré est non vide
 
        Dim CompareSymbole As Range
        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
 
 
            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
    End If
End If
 
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
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

**deedolith** · 06/12/2022, 00h07

Les paramètres, c'est la base de la programmation.
Revoit tes cours (ou trouves-en un potable).

**DeeJas** · 06/12/2022, 16h09

Effectivement, heureusement pour moi je ne suis pas débutant. En VBA si.
Le fait que je débute et tes explications trop mince font que je n'est pas de piste d'amélioration.
Je ne demande pas un code tout fait, mais d'avantage d'explications pour que je puisse moi même comprendre et programmer en conséquence.

**deedolith** · 06/12/2022, 17h45

Une petite recherche sur Google:
https://learn.microsoft.com/en-us/of...tion-statement

PS: Ce n'est pas sur l'optimisation que je te reprend, mais sur la qualité de ton code.
Et pour t'améliorer, il n'y a pas 36 solutions:
- Fait des recherches.
- Trouve un cours potable.

**DeeJas** · 11/12/2022, 12h06

Je ne comprend pas ce que je dois faire? Je tente des choses mais rien de concluant car je ne vois pas ce que je dois faire.. Dit le moi avec des mots que je puisse le transformer en code.
Passer "SupprimerImage" en fonction ? Et mettre en paramètre "PosLigne" et "Image" ?

Optimisation d'un code VBA pour remplacer une image en fonction d'une équivalence de cellule

Macros et VBA Excel

Discussions similaires

Partager

Partager