Discussion :

[JLK2015]

Bonjour, à tous

J'espère que cette demande de support Excel VBA se trouve au bon endroit.

Depuis que je suis passé sous environnement Excel office 365, Windows 10 Entreprise, j'ai une Macro VBA qui fonctionne de façon extrêmement lente.
Je ne peux plus l'utiliser, dans l'état.

Le problème semble venir de l'instruction GetPixel, qui prend maintenant beaucoup plus de temps à s'exécuter.
A l'origine, j'appelle cette instruction dans deux boucles imbriquées, jusqu'à 500 000 fois.
En fait, je fais de la reconnaissance de couleur pixel par pixel, sur la base de ce qui est affiché dans une zone précise de l'écran en cours.

Avant de rentrer dans le détail de la problématique "Code" deux questions aux experts.
1. << Avez-vous connaissance de ce genre de problème sur un environnement Windows 10 ? >>
2. << Pouvez-vous me donner quelques pistes d'investigation afin d'orienter mes recherches pour booster ma macro ? >>

A savoir :
J'ai également changé de PC, la configuration générale de ce nouveau PC est plus puissance et plus rapide que mon PC précédent datant de 5 ans.

Configuration actuelle:
Windows 10 Enterprise
Excel 365
VBA 7.1
Processeur Intel(R) Core(TM) i7-8706G CPU @ 3.10GHz, 3096 MHz, 4 cœur(s), 8 processeur(s) logique(s)
Mémoire physique (RAM) installée 16,0 Go
Mémoire physique totale 15,8 Go
Mémoire physique disponible 9,69 Go
Mémoire virtuelle totale 18,2 Go
Mémoire virtuelle disponible 8,53 Go

Je joins mon fichier Macro simplifié, le test consiste à scanner 500 pixels sur une seule colonne de l’écran actif, ceci prend plus de 8,3 sec sur ma configuration actuelle.

Pour info sur mon ancienne configuration PC datant de 5 ans, pour scanner 267 211 pixels (toute une zone) il me fallait 4 min 53 sec ce qui est dans mon cas acceptable. Si j’extrapole il me faudrait aujourd’hui, 1 Heure 13 Minute 58 Sec ce qui n’est pas possible compte tenu de mon besoin.

Remarque utilisation Exemple feuille et Macro associée,
1. Ouvrir Excel sur écran principal (Si vous avez un écran en extension la zone scanner n'est pas forcément cohérente.
2. J'ai ajouté des zones rouge, jaune, et vert pour avoir un résultat minimum, nb de pixel Rouge jaune et vert.
3. J'ai rajouté un méssage indiquant les resultats trouvés.
4. En mettant Excel en priorité haute à travers le gestionnaire de tache, le temps d'exécution c'est légèrement amélioré 6,6 seconde au lieu de 8,3 seconde. Reste à confirmer si c’est vraiment lié, il me faut faire plus de tests, et c'est de tout façon trop long pour mon besoin.


Merci par avance pour votre retour d’information.

Cordialement JLK

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
83
84
85
86
87
88
Option Explicit
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal Hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Sub ScanZone()
 
Dim TimerDebLoopNiv00 As Double
Dim TimerEndLoopNiv00 As Double
 
Dim ScanX As Single
Dim ScanY As Single
Dim PixelTotal              ' Valeure Calculée
Dim PixelVert               ' Vert Couleur RGB = 0, 160, 80
Dim PixelJaune              ' Jaune Couleur RGB = 255, 255, 0
Dim PixelRouge              ' Rouge Couleur RGB = 255, 0, 0
 
Dim Bluejlk As Integer
Dim Greenjlk As Integer
Dim Redjlk As Integer
 
Dim lDC As Variant
Dim lColour As Long
 
If MsgBox("Do you want to Scan ?", vbExclamation + vbYesNo + vbDefaultButton2, "Message Application test JLK2015") = vbNo Then End
 
'Application.ScreenUpdating = False 'Deactiver pour le test
 
On Error GoTo errorHandler
 
    PixelVert = 0               ' Vert Couleur RGB = 0, 160, 80
    PixelJaune = 0              ' Jaune Couleur RGB = 255, 255, 0
    PixelRouge = 0              ' Rouge Couleur RGB = 255, 0, 0
    PixelTotal = 0              ' Valeure Calculée
 
lDC = GetWindowDC(0)
'DoEvents ' A Confirmer si l'instruction est necessaire
 
'*** Pour tester le temps d'execution on va scanner une ligne verticale sur l'écran coordonnée pixel  x = 500 coordonnée y de 100 à 599  soit un total de 500 pixels ****
  TimerDebLoopNiv00 = Timer
  ScanX = 500 'Colonne pixel n° 500 de la fenêtre en cours
  For ScanY = 200 To 599 'Ligne pixel n° 100 à 600
 
        lColour = GetPixel(lDC, ScanX, ScanY)
        'DoEvents ' A voir si nécessaire
 
        'Fragmentation du code couleur en code RGB
        Redjlk = Int(lColour Mod 256)
        Greenjlk = Int((lColour Mod 65536) / 256)
        Bluejlk = Int(lColour / 65536)
 
        'Vert Couleur RGB = 0, 160, 80
        If Redjlk = 0 And Greenjlk = 160 And Bluejlk = 80 Then
            PixelVert = PixelVert + 1
        End If
 
        'Jaune Couleur RGB = 255, 255, 0
        If Redjlk = 255 And Greenjlk = 255 And Bluejlk = 0 Then
            PixelJaune = PixelJaune + 1
        End If
 
        'Rouge Couleur RGB = 255, 0, 0
        If Redjlk = 255 And Greenjlk = 0 And Bluejlk = 0 Then
            PixelRouge = PixelRouge + 1
        End If
 
        PixelTotal = PixelTotal + 1
 
 Next
        'Controle temps execution boucle
        TimerEndLoopNiv00 = Timer
        MsgBox "Analysis is finish" & Chr(10) _
        & "Execution time was: " & Chr(10) _
        & Round((TimerEndLoopNiv00 - TimerDebLoopNiv00), 3) & " Seconds" & Chr(10) _
        & "Number of pixel scanned " & PixelTotal & Chr(10) _
        & "Vert " & PixelVert & Chr(10) _
        & "Jaune " & PixelJaune & Chr(10) _
        & "Rouge " & PixelRouge _
        , vbInformation, "Message Application test JLK2015"
 
 
 
 
'Application.ScreenUpdating = True 'Deactiver pour le test
 
Exit Sub
errorHandler:
    MsgBox Err.Number & vbLf & Err.Description
 
End Sub

Pièce jointe 517343

[EricDgn]

Bonjour,

Recherche sur internet:
Win32api Getpixel Very Slow On Win10
mais peut-être (non vérifié) une solution sur ce post:
Easy way to get the pixel color at any screen location

Cordialement

[unparia]

Bonjour
Je n'aime en règle générale pas participer à l'utilisation d'un tableur (ce qu'est Excel) à d'autres fins que celles d'un tableur *******.
On peut toutefois (et là s'arrêtera ma participation) déjà se demander la raison de ralentir encore plus en transformant un numérique en ses composantes RGB puis de regarder si ces composantes correspondent à celles spécifiées, alors que la fonction RGB appliquée aux composantes spécifiées retourne un numérique pouvant directement être comparé à celui retourné par GetPixel.

NB : ******* : la copie d'écran que tu as montrée ne justifie pas la lenteur dénoncée, y compris avec une version "rapide antérieure" . Pour mémoire :

il me fallait 4 min 53 sec ce qui est dans mon cas acceptable

Je ne peux dans ces conditions qu'en conclure que le "balayage" qui t'intéresse est totalement autre que celui de ce que tu montres ici (qui ne nécessiterait que quelques toutes petites secondes, lui).

[Arkham46]

Bonjour,

De mon côté je confirme la lenteur de getPixel (ce n'est pas le calcul des composantes rgb qui ralenti le traitement à ce point).
Et c'est tout à fait normal, ce n'est pas une fonction prévue pour un tel usage.
Il existe des moyens pour récupérer tous les pixels d'un coup.
getDIBits fait très bien le travail. Il faut passer par une section DIB.
En fonction de tes connaissances sur le sujet, ça peut être plus ou moins compliqué.

Edit : s'il est possible d'expliquer l'utilité de ce scan des pixels, ce serait intéressant...

[unparia]

Je suis loin de contester que GetPixel est une fonction très lente. Ce n'est toutefois pas une raison pour rajouter des lenteurs supplémentaires parfaitement évitables (même si, elles, relativement peu significatives)

Quant à l'utilité de la démarche, elle me parait d'autant questionnable que le nombre de pixels (dans la copie d'écran montrée) dépendra (pour le même nombre de points), de la machine d'exécution.

[JLK2015]

Bonsoir,

Tout d’abord je voudrais vous remercier pour l’intérêt que vous portez à ce sujet, et la pertinence de vos propos. La communauté DEVELOPPEZ ,compte de grand passionnés dont vous faîtes sans aucun doute partie.

Pour ce qui me concerne, je ne suis qu’un modeste amateur, qui tente avec ces propres moyens de résoudre certains problèmes techniques qui se présente à lui. En générale les solutions adopter ne sont de loin pas des plus optimum, aucun doute là-dessus. Mais je reste pragmatique et si la solution fonctionne et supprime une part de ma problématique, ça me va.
Il se trouve qu’à travers le temps certaines variables externes (Evolution technologique), influence le fonctionnent de mon application, ce qui impose une remise en cause de mes solutions passés.

Réponses aux questions par ordre d’apparition :
EricDgn, Merci pour les liens, je vais m’empresser d’y faire un saut, quitte à réécrire mon code VBA en fonction de ce que j’y trouverais.

unparia, Merci pour vos commentaires, je suis en phase avec vos propos et je les partage totalement.
A. Dans la vie, il y a une raison à chaque chose, la manière donc j’ai codé, résulte de mon besoin, de mes connaissances et dans ce cas de la faculté du système à exécuter le code. La variable qui pose un problème ici c’est que le système d'exploitation a changé, et qu’à travers ce changement mon code ne soit plus fonctionnel.
Pour ce qui est de l’utilisation détourné d’Excel, certes c’est à la base un tableur, mais pourquoi donc avoir installé toutes ces portes si ce n’est pour les ouvrir .
B. Pour ce qui est du balayage, en fait la copie d’écran n’est là que pour l’exemple. La feuille et les rectangles colorés ne sont là que pour le test de la macro. Le but étant que lors du balayage de la colonne 500 de la ligne 200 à 599 on puisse « rencontrer » différentes couleurs à l’écran, le tout pour une meilleure compréhension de ma problématique. J’espère que c’est maintenant plus clair pour vous.

Arkham46, Je vous remercie pour la confirmation de lenteur de l’instruction « GetPixel »
A. Je vais me renseigner sur la fonction « getDIBits », je ne suis pas expert VBA, mais s’il faut recoder, je devrais accroitre mes connaissances. Au-delà de la passion, ici tout est une question de gain par rapport au temps que je peux allouer.
B. Dans le cadre d’un chat il ne m’est pas possible d’allez dans le détail de mon application, donc ce sera plutôt une explication grossière.
1. On prend comme base une image monochrome « surface de base »
2. On masque en rouge une/des zone(s) « surface R »
3. On masque en jaune une/des zone(s) « surface J »
4. On masque en vert une/des zone(s) « surface V »
5. On calcule le nombre de pixel de la surface de base, de la surface R, J et V
6. On exprime par rapport à la « surface de base » le pourcentage de pixel R, J et V
7. En fait dans l’image de base on trouve également une zone dite de référence, permettant une mise à l’échelle pix/m² permettant de s’affranchissant du rapport hauteur largeur. Le résultat est par définition à considérer comme une valeur + /- précise, compte tenu « du passage » par un écran d’affichage dont la « pixellisation » est relative au zoom de l’application et à la définition propre de l’écran.

unparia, D’après vos propos, je comprends que l’instruction « GetPixel » n’est enfaite pas si lente, c’est là qu'est le paradoxe => tout est relatif, ce qui est sure c’est que l’application sur laquelle on débat, avec ou sans les améliorations évoquées, fonctionnée de façon plutôt satisfaisante avec mon ancien pc, aujourd’hui elle n’est plus utilisable dans l’état.

J’espère que vous avez reçu de ma part la réponse à vos interrogations légitimes.

Je poursuis mon petit bonhomme de chemin, et qui sait, avec votre support et celui de la communauté un jour on pourrait peut-être clore ce blog en y apportant une réponse à la question de base qui est :

« Pourquoi une macro s’exécute de façon significativement plus lente en passant d’un système Windows 7 Entreprise, à un système Windows 10 Entreprise »

Sachant que je suis passé d’un PC
Intel(R) Core(TM) i7-4810MQ CPU @ 2.80GHz, 2801 MHz, 4 cœur(s), 8 processeur(s) logique(s), 16Go
Windows 7 Entreprise version 6.1
Office 365 ProPlus, Excel Version 1902

A un PC de même marque plus performant.
Intel(R) Core(TM) i7-8706G CPU @ 3.10GHz, 3096 MHz, 4 cœur(s), 8 processeur(s) logique(s), 16 Go
Windows 10 Entreprise version 1903
Office 365 ProPlus, Excel Version 1902

J’ai toujours la possibilité de comparer les paramètres des 2 PC’s ce que je vais faire dès que possible, çà enlèvera quelques doutes.

Encore une fois merci, et un bon weekend à venir.
Cordialement JLK2015

[Arkham46]

Bonsoir,

Merci pour les explications, même si je n'ai pas saisi tous les tenants et aboutissants.

Dans l'exemple, la source est device context de l'écran.
Dans l'application réelle, qu'elle est la source de l'image ?
En fonction de ce qu'on a en sourc, le code est différent.

Edit: avec un i7, j'ai des temps similaires, avec uniquement un appel à getpixel dans chaque itération.

[JLK2015]

Bonsoir, Arkham46

Tout d’abord je voudrais vous remercier pour votre retour.

Sur la base de vos infos, je me suis orienté vers la fonction, GetDIBits.
Malheureusement je n’ai pas abouti, je ne trouve pas d’exemples complet qui me permettent d’avancer dans ma problématique. Faute certainement à mon niveau d’expertise VBA.

Je suis en fait arrivée à la conclusion qu’il me fallait restructurer mon code voir simplifier ma demande.

Pour faire simple, si vous aviez en exemple d’un code VBA qui utilise GetDIBits, code qui permette de compter les pixels d’une simple forme voire copie ci-jointe, cela m’arrangerait grandement. Ceci afin de test le temps d’exécution.



Exemple, Rouge RGB (255,0,0), Jaune RBG (255,255,0), Vert RGB (0,160,80) et Bleu RGB (0,100,200)

Si ce code pouvez à terme également fonctionner pour une image type jpeg, ce serait un grand plus, puisque nous ne passerions plus par la résolution de l’écran mais directement par la définition de l’image, au bénéfice de la précision.

En partant sur ce principe, je pourrais adapter le reste de mon code existant pour recompléter mon application.

Je vous remercie par avance pour toutes informations qui pourrait m’orienté dans la résolution de mon problème.
Cordialement JLK2015

[Arkham46]

Bonjour,

Si vous avez une image en entrée, il faut la traiter en mémoire sans passer par l'écran.

Voir le module de classe clGdi32, ou clGdiplus si besoin (clGdiplus prend en charge le png).
Un loadFile suivi d'un savePixels devrait suffire.

[JLK2015]

Bonjour, Arkham46

Je vous remercie pour votre réactivité, pour les infos et les liens.
Je vais y travailler, et je ne manquerais pas de vous informer ainsi que les lecteurs sur l’issue de notre démarche.
En attendant, je vous souhaite une très agréable journée.

Cordialement JLK2015

[EricDgn]

Bonjour,

En suivant les liens donnés Arkham46, j'ai adapté le code intial, et cela ne prend pas 1 seconde pour traiter l'image donnée en exemple.
Seul problème, les couleurs ne sont pas aussi "stables" qu'elles en ont l'air comme vous pouvez le voir ci-dessous avec 4 "verts" qui semblent identiques mais ne le sont pas. C'est comme s'il y avait des modifications liées aux superpositions de couleurs, mais je n'en sais pas plus.

Cordialement.

[JLK2015]

Bonjour, EricDgn

Merci pour cette bonne très bonne nouvelle, concernant le temps d’exécution et la faisabilité téchnique.

Pour des raisons de sécurité, je ne peux ouvrir le fichier attaché sur mon PC professionnel.
Je ne manquerais pas de faire le test sur mon PC perso dès mon retour en fin de semaine.

Pour ce qui est des couleurs, il est possible que la dégradation soit dû au fait que j’ai enregistrer les formes copiées sur Excel, au format .jpeg en utilisant le presse-papier et Photoshop 13 Element. Il est également possible que mon enregistrement Photoshop ai été mal paramétré. A voir.

EricDgn, Je vous remercie, pour vos efforts et votre aimable soutien.

Cordialement JLK2015

[EricDgn]

Aussi juste pour info, code dans UserForm1:

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Option Explicit
 
Private Declare Function GetPixel Lib "Gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
 
Private Type POINT
    X As Long
    Y As Long
End Type
 
Private Sub btnImg_Click()
   With Application.FileDialog(msoFileDialogOpen)
      .AllowMultiSelect = False
      .InitialFileName = ThisWorkbook.Path
      If .Show <> 0 Then
         Me.Image1.Tag = .SelectedItems(1)
         Me.Image1.Picture = LoadPicture(Me.Image1.Tag)
         Debug.Print Me.Image1.Tag
      End If
   End With
End Sub
 
Private Sub btnScan_Click()
'--- utilise le module de classe clGdiplus
'--- https://arkham46.developpez.com/articles/office/clgdiplus/tuto/tuto-apprendre-gdiplus/
   Dim oGdi As clGdiplus
   Dim sFile As String
   Set oGdi = New clGdiplus
   ' Chargement de l'image
   sFile = Me.Image1.Tag
   Debug.Print sFile
   If oGdi.LoadFile(sFile) Then
       ' Chargement réussi
       Debug.Print "Format :", oGdi.ImageFormatText
       Debug.Print "Taille :", oGdi.ImageWidth & " x " & oGdi.ImageHeight
   Else
       ' Erreur de chargement
       MsgBox "Erreur au chargement de l'image"
       Exit Sub
   End If
 
   Dim TimerDebLoopNiv00 As Double
   Dim TimerEndLoopNiv00 As Double
   Dim ScanX As Long
   Dim ScanY As Long
   Dim PixelTotal As Long              ' Valeur Calculée
   Dim PixelVert As Long               ' Vert Couleur RGB = 0, 160, 80
   Dim PixelJaune As Long              ' Jaune Couleur RGB = 255, 255, 0
   Dim PixelRouge As Long              ' Rouge Couleur RGB = 255, 0, 0
   Dim PixelBleu As Long
   Dim EstVert As Long
   Dim EstRouge As Long
   Dim EstJaune As Long
   Dim EstBleu As Long
   Dim lColour As Long
 
   EstVert = Me.c1
   EstJaune = Me.c2
   EstRouge = Me.c3
   EstBleu = Me.c4
   PixelVert = 0
   PixelJaune = 0
   PixelRouge = 0
   PixelTotal = 0
 
   TimerDebLoopNiv00 = Timer
   For ScanX = 0 To oGdi.ImageWidth - 1
      For ScanY = 0 To oGdi.ImageHeight - 1
         lColour = oGdi.GetPixel(ScanX, ScanY)
         If lColour = EstVert Then
             PixelVert = PixelVert + 1
         ElseIf lColour = EstJaune Then
             PixelJaune = PixelJaune + 1
         ElseIf lColour = EstRouge Then
             PixelRouge = PixelRouge + 1
         ElseIf lColour = EstBleu Then
             PixelBleu = PixelBleu + 1
         End If
         PixelTotal = PixelTotal + 1
      Next ScanY
   Next ScanX
   '--- temps execution boucle
   TimerEndLoopNiv00 = Timer
   Me.TextBox1.Text = Round((TimerEndLoopNiv00 - TimerDebLoopNiv00), 3) & " sec." & Chr(10) _
         & "Pixels: " & PixelTotal & Chr(10) _
         & "C1: " & PixelVert & Chr(10) _
         & "C2: " & PixelJaune & Chr(10) _
         & "C3: " & PixelRouge & Chr(10) _
         & "C4: " & PixelBleu & Chr(10) _
         & "C1234:" & PixelVert + PixelJaune + PixelRouge + PixelBleu
End Sub
 
'--- c1, c2, c3, c4 textbox utilisés pour entrer les couleurs (long) à scanner
'--- cc1, cc2, cc3, cc4 textbox utilisés pour montrer ces couleurs et leurs codes RGB
 
Private Sub c1_Change()
   Me.cc1.BackColor = Me.c1
   Me.cc1.Text = sRGB(Me.c1)
End Sub
 
Private Sub c2_Change()
   Me.cc2.BackColor = Me.c2
   Me.cc2.Text = sRGB(Me.c2)
End Sub
 
Private Sub c3_Change()
   Me.cc3.BackColor = Me.c3
   Me.cc3.Text = sRGB(Me.c3)
End Sub
 
Private Sub c4_Change()
   Me.cc4.BackColor = Me.c4
   Me.cc4.Text = sRGB(Me.c4)
End Sub
 
Private Sub Image1_Click()
    Dim pLocation As POINT
    Dim lColour, lDC As Long
    lDC = GetWindowDC(0)
    Call GetCursorPos(pLocation)
    lColour = GetPixel(lDC, pLocation.X, pLocation.Y)
    Me.TextBox1.Text = Right(Me.TextBox1.Text & vbCrLf & lColour, 100)
End Sub
 
Private Sub UserForm_Initialize()
   Me.Image1.Picture = Nothing
End Sub

et dans un module:

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
Option Explicit
 
Sub Bouton1_Cliquer()
   UserForm1.Show
End Sub
 
Public Function sRGB(c As Long) As String
   Dim Bluejlk As Integer
   Dim Greenjlk As Integer
   Dim Redjlk As Integer
    'Fragmentation du code couleur en code RGB
   Redjlk = Int(c Mod 256)
   Greenjlk = Int((c Mod 65536) / 256)
   Bluejlk = Int(c / 65536)
   sRGB = Redjlk & "~" & Greenjlk & "~" & Bluejlk
End Function

Bonne continuation.

[Arkham46]

Bonjour,

Avec clGdiplus (ou clGdi32), savePixels retourne un tableau de byte représentant l'image complète.
C'est plus rapide que de faire des getPixel (qui de toute façon fait la même chose mais isole ensuite un pixel).

Sinon effectivement il faut une image non compressée. Le jpeg altère l'image.