impossibilité de selection d'une zone dans une image en vba

**Michel-philippines** · 12/10/2023, 08h59

Bonjour a toutes et à tous

pour un usage specifique de récuperation de données d'un tableur excel imprimée sur du papier
je dois faire un scan d'une feuille excel, l'afficher dans une zone image d'un user forme
pouvoir selectionné une zone correspondant a une cellule, enregistrer cette selection en jpg, l'envoyer tesseractOCR pour recupérer un text que je peux retravailler

Mon probleme et que je n arrive pas a selectionner la zone affiché dans ma zone image
quelqu un pourrait il me dire ce que je fais de travers (je ne suis pas un expert en vba)
je precise le scan fonctionne super bien
le chargement de la page individuelle aussi
L lancement de la selection "titre" demarre Bien mais IMPOSSIBLE d'avoir acces a l'image pour faire une selection
on boucle dans l attente d evenement, on n'accede jamais au fonction de gestion de souris (c'est comme tom et jerry qui n'arrive jamais a manger jerry)
D'avance merci

Voici le detail
mon user forme
Nom : Capture 1.JPG
Affichages : 92
Taille : 88,6 Ko

Nom : Capture 1.JPG
Affichages : 92
Taille : 88,6 Ko

les parrametre du Userform
Nom : Capture 2.JPG
Affichages : 92
Taille : 131,4 Ko

les parrametres de la zone image
Nom : Capture 3.JPG
Affichages : 95
Taille : 83,9 Ko

mon code

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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
 
Option Explicit
 
' Variables pour suivre si la sélection est en cours
Public SelectionEnCours As Boolean
Public X1 As Single
Public Y1 As Single
Public X2 As Single
Public Y2 As Single
Dim ActionOCR As String ' Variable pour stocker le type d'action OCR
 
Private Sub FermerBT_Click()
    Unload Me
End Sub
 
Private Sub TitleBt_Click()
    ' Configuration de base
    ActionOCR = "Titre"
 
    ' Sélection de zone
    ' Passer le formulaire en mode non modal
    Me.Show vbModeless
 
    ' Activer la sélection
    SelectionEnCours = True
 
    ' Afficher un message demandant à l'utilisateur de sélectionner une zone
    MsgBox "Veuillez sélectionner une zone en cliquant et en faisant glisser la souris pour " & ActionOCR, vbInformation
 
    ' Attendez que l'utilisateur fasse une sélection
    Do While SelectionEnCours
        DoEvents ' Permet à l'application de gérer les événements
    Loop
 
    ' Copie et sauvegarde de la zone sélectionnée en tant qu'image JPEG
    Dim FicCible As String
    FicCible = RepExport & "\" & ActionOCR & ".jpg"
    CopierEtSauvegarderSelection FicCible
 
    ' Repasser le formulaire en mode modal
    Me.Show vbModal
 
 
    Call Programme.UtiliserTesseractOCR
 
    Dim cheminImage As String
    Dim cheminTexte As String
    Dim strCommand As String
 
    ' Charger le résultat de l'OCR dans FamilleTxt et FamillecorrigeTxt
    Dim FichierTxt As String
    FichierTxt = cheminTexte
    If Len(Dir(FichierTxt)) > 0 Then
        ' Utilisez la fonction FileToStr pour lire le contenu avec l'encodage UTF-8
        Dim contenuFichier As String
        contenuFichier = FileToStr(FichierTxt, "UTF-8")
 
        ' Affecter le contenu au contrôle de zone de texte
        CreerFamilleForm.FamilleTxt.Text = contenuFichier
        CreerFamilleForm.FamillecorrigeTxt.Text = contenuFichier
    End If
    contenuFichier = Replace(contenuFichier, vbCrLf, "  ")
 
    ' Afficher le formulaire CreerFamilleForm
    CreerFamilleForm.Show vbModal ' vbModal pour afficher le formulaire en mode modal
End Sub
 
Private Sub ChargePage_Click()
    Dim cheminImageSource As String
 
    ' Utilisez la boîte de dialogue de sélection de fichier pour choisir un fichier dans RepExport
    With Application.fileDialog(msoFileDialogFilePicker)
        .Title = "Sélectionnez une image"
        .InitialFileName = RepExport
        .Filters.Add "Images", "*.jpg;*.jpeg;*.png;*.bmp;*.gif;*.tiff"
        If .Show = -1 Then ' L'utilisateur a sélectionné un fichier
            cheminImageSource = .SelectedItems(1)
               ' Appeler la procédure AfficherScan avec le chemin de l'image source en tant qu'argument
            Call Programme.AfficherScan(cheminImageSource)
        End If
    End With
End Sub
Private Sub Scanner_Click()
    Call Programme.initialisation
    Call Programme.ScannerPage
    Dim cheminImage As String
    cheminImage = RepExport & "\frequence.jpg"
       ' Appeler la procédure AfficherScan avec le chemin de l'image source en tant qu'argument
    Call Programme.AfficherScan(cheminImage)
 
End Sub
Function FileToStr(ByVal filePath As String, ByVal encoding As String) As String
    Dim fileNumber As Integer
    Dim fileContents As String
 
    fileNumber = FreeFile
    Open filePath For Input As fileNumber
 
    If encoding = "ANSI" Then
        fileContents = Input$(LOF(fileNumber), fileNumber)
    ElseIf encoding = "UTF-8" Then
        ' Lire le contenu du fichier avec l'encodage UTF-8
        Dim stream As Object
        Set stream = CreateObject("ADODB.Stream")
        stream.Open
        stream.Type = 2 ' adTypeText
        stream.Charset = "utf-8"
        stream.LoadFromFile filePath
        fileContents = stream.ReadText
        stream.Close
    End If
 
    Close fileNumber
    FileToStr = fileContents
End Function
 
Public Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' Si la sélection est en cours, changez la forme du pointeur en une croix de sélection
    If SelectionEnCours Then
        ImageControl.MousePointer = 9 ' Constante pour la forme de la croix
    Else
        ImageControl.MousePointer = 0 ' Constante pour la forme par défaut
    End If
End Sub
 
Public Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' Lorsque l'utilisateur clique pour la première fois, enregistrez les coordonnées de début
    X1 = X
    Y1 = Y
    ' Indiquez que la sélection est en cours
    SelectionEnCours = True
End Sub
 
Public Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' Lorsque l'utilisateur relâche le clic, enregistrez les coordonnées de fin
    X2 = X
    Y2 = Y
    ' Indiquez que la sélection est terminée
    SelectionEnCours = False
 
    ' Maintenant, vous pouvez utiliser X1, Y1, X2 et Y2 pour définir la zone de sélection
    ' et effectuer la copie et la sauvegarde de la zone en tant qu'image JPEG
End Sub
 
' Fonction pour copier et sauvegarder la zone sélectionnée en tant qu'image JPEG
Public Sub CopierEtSauvegarderSelection(FicCible As String)
    ' Vérifiez si les coordonnées de début et de fin de la sélection sont valides
    If X1 = 0 Or Y1 = 0 Or X2 = 0 Or Y2 = 0 Then
        MsgBox "Please select an area to copy first.", vbExclamation
        Exit Sub
    End If
 
    ' Créez un objet GdPicture
    Dim gdPicture As Object
    Set gdPicture = CreateObject("GdPicture.GdPicture.10")
 
    ' Chargez l'image source
    Dim imagePath As String
    imagePath = ImageControl.Picture
    If gdPicture.LoadFromFile(imagePath) = 0 Then
        MsgBox "Unable to load the image.", vbExclamation
        Exit Sub
    End If
 
    ' Calculez les coordonnées de la zone sélectionnée
    Dim width As Long
    Dim height As Long
    width = X2 - X1
    height = Y2 - Y1
 
    ' Copiez la zone sélectionnée
    gdPicture.Crop X1, Y1, width, height
 
    ' Enregistrez la zone sélectionnée en tant qu'image JPEG
    If gdPicture.SaveAsJPEG(FicCible, 75) = 0 Then
        MsgBox "Error while saving the image.", vbExclamation
    Else
        MsgBox "The selection has been copied and saved as a JPEG image.", vbInformation
    End If
 
    ' Libérez les ressources de GdPicture
    gdPicture.CloseImage
    Set gdPicture = Nothing
End Sub

**Tête de chat** · 12/10/2023, 09h52

Bonjour,

je pense qu'il y a une erreur de logique (mélange procédural/événementiel) ici :

Code :

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

1
2
3
  Do While SelectionEnCours
        DoEvents ' Permet à l'application de gérer les événements
    Loop

En aucun cas ça ne va "boucler en attendant que la souris bouge", ça boucle seulement comme tu l'as bien vu

1. Transforme SelectionEnCours en single pour avoir 3 états : 0 pas commencée, 1 demandée, 2 commencée
2. Dans le Title_clik remplacee le while ci-dessus par un init de SelectionEnCours à 1 et arrête le sub là
3. Dans le mouse_down si SelectionEnCours=1 passe le à 2 et mémorise X1,Y1 et c'est tout
4. Dans le MouseUp si SelectionEncours = 2 passe le à 0, mémorise X2,Y2 puis fais la sauvegarde etc. (fin actuelle du title_click).

ça devrait aller mieux...

**Michel-philippines** · 12/10/2023, 10h22

Envoyé par Tête de chat

Bonjour,

je pense qu'il y a une erreur de logique (mélange procédural/événementiel) ici :

Code :

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

1
2
3
  Do While SelectionEnCours
        DoEvents ' Permet à l'application de gérer les événements
    Loop

En aucun cas ça ne va "boucler en attendant que la souris bouge", ça boucle seulement comme tu l'as bien vu

1. Transforme SelectionEnCours en single pour avoir 3 états : 0 pas commencée, 1 demandée, 2 commencée
2. Dans le Title_clik remplacee le while ci-dessus par un init de SelectionEnCours à 1 et arrête le sub là
3. Dans le mouse_down si SelectionEnCours=1 passe le à 2 et mémorise X1,Y1 et c'est tout
4. Dans le MouseUp si SelectionEncours = 2 passe le à 0, mémorise X2,Y2 puis fais la sauvegarde etc. (fin actuelle du title_click).

ça devrait aller mieux...

Ok je teste tout ca

**Michel-philippines** · 13/10/2023, 05h25

Envoyé par Tête de chat

Bonjour,

je pense qu'il y a une erreur de logique (mélange procédural/événementiel) ici :

Code :

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

1
2
3
  Do While SelectionEnCours
        DoEvents ' Permet à l'application de gérer les événements
    Loop

En aucun cas ça ne va "boucler en attendant que la souris bouge", ça boucle seulement comme tu l'as bien vu

1. Transforme SelectionEnCours en single pour avoir 3 états : 0 pas commencée, 1 demandée, 2 commencée
2. Dans le Title_clik remplacee le while ci-dessus par un init de SelectionEnCours à 1 et arrête le sub là
3. Dans le mouse_down si SelectionEnCours=1 passe le à 2 et mémorise X1,Y1 et c'est tout
4. Dans le MouseUp si SelectionEncours = 2 passe le à 0, mémorise X2,Y2 puis fais la sauvegarde etc. (fin actuelle du title_click).

ça devrait aller mieux...

ça va nettement mieux je recupere bien mes X 2 Y1

MERCI BEAUCOUP

impossibilité de selection d'une zone dans une image en vba [XL-365]

Macros et VBA Excel

Discussions similaires

Partager

Partager