Sub infoimage()
Dim bm_départ As BITMAP
Dim x1&, y1&, m&, l&, n&, p&, i&, hDC&
Dim Tablo(), tabfin()
Dim Rep As Byte, Rep1 As Byte
fich_img = Application.GetOpenFilename(, , "choisissez l'image à récupérer (.bmp)")
If fich_img = False Then Exit Sub
Application.ScreenUpdating = False
'récupérer l'image
écran_DC = GetDC(0)
Set img_départ = LoadPicture(fich_img)
GetObjectAPI img_départ.Handle, Len(bm_départ), bm_départ 'récupère le bitmap correspondant à l'image
'créer un bitmap img_ini, dans le imgDC pour y accueillir l'image
img_DC = CreateCompatibleDC(écran_DC)
img_DCOld = SelectObject(img_DC, img_départ)
'récupération des colonnes de mon image
larg = bm_départ.bmWidth
haut = bm_départ.bmHeight
p = larg * haut
ReDim Tablo(0 To p, 0 To 3)
For x1 = 0 To larg - 1
n = 0
l = 1
For y1 = 0 To haut - 1
pix = GetPixel(img_DC, Int(x1), Int(y1))
If n = 0 Then
If pix = 0 Then
n = y1 - 1
l = 1
End If
Else
If pix = 0 Then
l = l + 1
Else
m = m + 1
Tablo(m, 0) = x1
Tablo(m, 1) = n
Tablo(m, 2) = n + l + 1
Tablo(m, 3) = 0
n = 0
l = 0
End If
End If
Next
Next
'reprise dans la colonne 3 des répétitions
Index = 0
For i = 1 To m
If Tablo(i, 0) = Tablo(i - 1, 0) Then
Tablo(Index, 3) = Tablo(Index, 3) + 1
Else
Index = i
Tablo(Index, 3) = Tablo(Index, 3) + 1
End If
Next
For i = 1 To m
If Tablo(i, 3) = 0 Then
Tablo(i, 3) = Tablo(i - 1, 3)
End If
Next
'Création Tableau final
Rep = 0
Ind = 0
While Ind < UBound(Tablo, 0)
If Tablo(Ind, 3) = Rep Then
x = x + 1
For i = 0 To 2
ReDim Preserve tabfin(0 To 2, 0 To x)
tabfin(i, x) = Tablo(Ind + Rep1, i)
Next i
If Rep1 = 1 Then Rep1 = Rep Else Rep1 = Rep1 - 1 ''''ici dépassement capacité
Ind = Ind + Rep
Else
Rep = Tablo(Ind, 3)
Rep1 = Rep
End If
Wend
F2.Range("G2").Resize(UBound(tabfin, 2), UBound(tabfin, 1)) = Application.Transpose(tabfin)
Application.ScreenUpdating = True
Set img_départ = Nothing
DeleteObject SelectObject(img_DC, img_DCOld)
DeleteDC img_DC
End Sub