Réaliser une matrice avec Excel

[SERIEUXETCOOL]

Bonsoir le Forum,

J'ai un petit problème de codage... Voici ce que je cherche à faire. Je dispose d'un axe X définit sur une plage [XD;XF]. Je parcours l'axe X en incrémentant d'un pas nommé PX.
J'ai la même chose avec un second axe, l'axe Y. Il est définit par une plage [YD;YF]. Et on parcours l'intégralité de cet axe avec un pas qui vaut PY.

XD,XF,PX, et YD,YF,PY sont des variables de types Double et sont à fixer par l'utilisateur. Elles sont donc connues et le système est donc paramétré.

Maintenant je cherche à remplir 2 colonnes dans une feuille Excel de la manière suivante :

Colonne A / Colonne B
XD / YD
XD / YD+PY
XD / YD+PY+PY
...
XD / YF
XD+PX / YD
XD+PX / YD+PY
XD+PX / YD+PX+PX
...
XD+PX / YF
XD+PX+PX / YD
ETC

Je ne parviens pas à réaliser cette matrice ! Un peu d'aide serait la bien venue si possible.

Au cas ou ma méthodologie ne soit pas la bonne, je donne quelques détails sur ce que je souhaite faire du code. En gros j'ai 2 axes X et Y qui représentent une largeur de photo en pixel et une hauteur de photo en pixel. Je désire placer un certains nombre de points sur cette photo avec la résolution que je veux. Mais je n'arrive pas à automatiser le placement des points car je ne sais pas créer la matrice.

Je reste disponible si vous avez besoin de plus d'infos.

André

 

[R@chid]

Re : Réaliser une matrice avec Excel

Salut,
c'est possible avec un fichier exemple fiable ...
@ te relire

 

[Dranreb]

Re : Réaliser une matrice avec Excel

Bonjour
Cherchez vous à modifier des image ?
Avec ou sans palette ?
Je sais lire et écrire des .bmp
Je sais aussi récupérer la Map d'une Picture en tableau. Et la modifier aussi.
Je ne sais pas créer une Picture ni modifier ses dimensions, sauf en créant un bmp puis l'affecter par LoadPicture
Remarquez ça existe, mais c'est étonnamment compliqué ! Je n'ai jamais réussi à faire fonctionnez des exemples trouvés de ci de là.
À +

 

[SERIEUXETCOOL]

Re : Réaliser une matrice avec Excel

-Rachid j'ai mis un fichier Excel en pièce jointe. L'exemple est très simple bien sur. En gros j'ai placé des points le long d'un axe X et d'un axe Y. Il y a 18 points qui sont placés. Ces 18 points correspondent à une certaines résolution qui doit pouvoir être paramétrable.

J'espère que tu y verras mieux avec le fichier.


-Dranreb, je dispose d'une photo. Sur cette photo je vais chercher à placer un certains nombre de points. Plus je placerais de points meilleurs seront les résultats mais les temps de calculs seront plus longs également. Une fois les points placés sur la photo, j'aimerais récupérer des données relatives au pixel. En gros je vais récupérer la lumière du pixel.
Une fois récupérer la position du pixel (X,Y) ainsi que la coordonnée de lumière, je pourrais alors réaliser un graphique 3D qui montrerait (en 3D justement) une photo 2D.

Voila en gros ce que j'aimerais faire. Je ne sais pas si j'ai été clair. C'est vrai que moi je suis tête dans le guidon la^^

Mes photos sont en .Tif. Dranreb que veux tu dire par récupérer la Map d'une picture en tableau ? On dirait que ça ressemble à ce que je veux faire... En gros je te donne une photo, et tu me sors la coordonnée de chaque pixel ???




Des remarques ou des conseils je suis preneur !

André

 

[Dranreb]

Re : Réaliser une matrice avec Excel

Si c'est un .bmp pas de problème pour l'analyser. Si c'est autre chose il faut pouvoir l'affecter à la propritété Picture d'une Image ou d'une PictureBox [par: Img.Picture = LoadPicture(RéfFic)]. Sinon je ne peux rien faire.

 

[SERIEUXETCOOL]

Re : Réaliser une matrice avec Excel

Je pense qu'il est possible d'enregistrer mon image au format .bmp
Je doit juste m'assurer si je ne perds pas des infos en changeant de format mais ça doit être bon.

Du coup si j'ai une image .bmp peut tu me dire ce qu'il est possible de faire en gros ? Je n'ai jamais utilisé de photos sous Excel encore.

J'aimerais avoir un apperçu de ce qu'il est possible de faire, et de ce que toi tu sais déjà faire

Je suis curieux de voir tout ça...

André

 

[Dranreb]

Re : Réaliser une matrice avec Excel

Extrait d'un classeur qui me permet de retoucher des photos :

Sub ChargerImageBMP()
Tâche "Chargement de l'image (plan B)"
If UCase(Right(ChNomF, 4)) <> ".BMP" Then
   AbandonTâche "ce n'est pas un fichier "".bmp"""
   MsgBox "Seuls des "".bmp"" peuvent être chargés par le plan de secours", vbCritical, NomTâche
   Exit Sub: End If
Open ChNomF For Binary Access Read As #1 Len = 1
Dim BM As String * 2: Get #1, 1, BM
If BM <> "BM" Then AbandonTâche "fichier "".Bmp"" non valide": MsgBox "Ce n'est pas un fichier ""Bmp"" valide.", _
   vbCritical, NomTâche: Close #1: Exit Sub
Get #1, 11, LgE: Get #1, 19, XbmMax: Get #1, 23, YbmMax: Get #1, 29, BitPx
LgL = 4 * ((XbmMax * BitPx + 31) \ 32)
ReDim PxBrut(1 To 3, 1 To XbmMax, 1 To YbmMax) As Byte
Tâche , XbmMax * YbmMax
If BitPx = 24 Then
   For Y = 1 To YbmMax
      Seek #1, LgE + LgL * (YbmMax - Y) + 1
      For X = 1 To XbmMax
         For C = 1 To 3: Get #1, , PxBrut(C, X, Y): Next C
         Call OùÇaEnEst: Next X
      Next Y
   Succès = True
ElseIf BitPx = 8 Then
   ReDim Pal(0 To 255, 1 To 3) As Byte
   For C = 0 To 255
      Get #1, 4 * C + 55, Pal(C, 1): Get #1, , Pal(C, 2): Get #1, , Pal(C, 3)
      Next C
   For Y = 1 To YbmMax
      Seek #1, LgE + LgL * (YbmMax - Y) + 1
      For X = 1 To XbmMax
         Get #1, , Oct
         For C = 1 To 3: PxBrut(C, X, Y) = Pal(Oct, C): Next C
         Call OùÇaEnEst: Next X
      Next Y
   Succès = True
Else
   AbandonTâche "format non supporté"
   MsgBox "Image à " & BitPx & " bits / pixel non supporté", vbCritical, NomTâche
   End If
Close #1
End Sub

Utilise certaines de ces déclarations en tête du module :

Dim ChNomF As String, LgL As Long, NbCoul As Long, LgE As Long, LgM As Long, LgF As Long
Dim Oct As Byte, BitPx As Integer, Succès As Boolean

Et aussi, ailleurs :

Public XbmMax As Long, YbmMax As Long, X As Long, Y As Long, C As Long, _
   PxBrut() As Byte, ÉR() As Double, ÉV() As Double, ÉB() As Double, _
   tE() As Double, tH() As Double, tJ() As Double, EnMini As Double, EnMaxi As Double

À +

 

[SERIEUXETCOOL]

Re : Réaliser une matrice avec Excel

J'ai bien regardé le fichier mais c'est un peu compliqué pour moi encore.

Peux tu me dire concrètement ce que tu es capable de faire une fois ton image .bmp chargée ?

Comme ça je saurais ce qu'il est possible de faire et si c'est en accord avec mon besoin.

Idéalement, après avoir ouvert ta photo, j'aimerais extraire dans une feuille Excel les coordonnées de chaque pixel en X et en Y, ainsi que les composantes RGB du pixel. Et j'aimerais convertir le format RGB en HSI. Mais je ne sais pas si c'est envisageable avec Excel.
Pourtant ça ne semble pas compliqué...a première vue.

André

 

[Dranreb]

Re : Réaliser une matrice avec Excel

Bonjour.
Ça va faire beaucoup de cellules ça !
Oui tout se retrouve après le chargement dans PxBrut.
Il suffit donc de le copier dans des cellules.
Dans la transformation HSI, H c'est hue (angle). Ça ressemble à ma transformation EAF (Énergie, Angle, Force)
Toutefois mon Énergie est une valeur d'énergie captée par les bâtonnets de la rétine et non d'énergie rayonnée.
Deux teintes complètement différentes de même énergie auront à peu près la même luminosité apparente.

P.S. Quelle est donc la vraie finalité de tout cela ? Il me semble qu'une plage décrivant des valeurs de pixels est assez illisible, c'est donc en vue d'autre chose que vous le voulez, mais quoi ? Il y a de forte chance que l'information ultime désirée se calculera plus aisément et rapidement en VBA qu'avec des formules.
Que représentent au départ vos images et que voulez vous mettre en évidence à l'arrivée ?
À +

 

[SERIEUXETCOOL]

Re : Réaliser une matrice avec Excel

Dranreb j'ai étudié un peu tes fichiers... Je me demande si le niveau n'est pas un peu trop élevé pour moi d'un coup^^

Je ne parviendrais pas à réaliser mon projet si je n'avance pas petit à petit.

Je vois que l'on peut faire un certain nombre de choses via VBA. Et c'est une bonne chose. Mais vu mon niveau je vais devoir avancer doucement...Tout doucement

Je vais admettre que ma demande est réalisable via Excel. On va donc essayer de poser les briques petit à petit.

-La première chose que j'aimerais faire sous Excel, c'est de proposer à l'utilisateur de charger une photo au format .bmp. Déjà comment fait on cette petite opération ? Ou charge t'on l'image ? Visualise ton l'image ou pas ?

J'ai utilisé ceci dans un de mes codes précédents pour ouvrir des fichiers textes :

Chemin = "TEST" 'Pour que la boucle ne s'arrête pas tout de suite

On Error Resume Next 'Place un gestionnaire d'erreurs qui saute l'instruction défectueuse
Chemin = Application.GetOpenFilename("Texte, *.txt")  'Boite de dialogue
If (Err.Number > 0) Then 'Indique le numéro de l’erreur. Ce numéro est unique et dépend également de l’application
    MsgBox Err.Description 'Cette propriété indique la description de l’erreur
    GOON = False 'Variable publique qui change d'état
    On Error GoTo 0 'Enlève le gestionnaire d'erreur s'il était mis en place
    Exit Sub
End If
On Error GoTo 0 'Enlève le gestionnaire d'erreur s'il était mis en place

If InStr(Chemin, "\") = 0 Then 'Si Chemin n'a pas de \ donc que l'opérateur a fait annuler
GOON = False 'Variable publique qui change d'état
GoTo Fin 'Va à l'étiquette Fin:
End If 'Fin du test
Open Chemin For Input As #1 'Ouvre un fichier en lecture

J'imagine que pour charger une image c'est un peu pareil ? Alors si déjà on pouvait avoir un petit exemple de la chose, ce serait un bon début.

Faut il passer par un UserForm pour faire afficher l'image ? Un WebBrowser peut être ? Bref je suis perdu pour commencer.

André

 

[Dranreb]

Re : Réaliser une matrice avec Excel

Je vous aurais bien donné mon RéglPhoto.xls mais il est définitivement trop gros. Alors je vous en donne d'autres extraits:

   Va = Application.GetOpenFilename(Tous,*.bmp;*.jpg;*.gif;*.ico;*.cur;*.dib;*.emf;*.wmf,Images,*.bmp;*.jpg;*.gif,Bitmaps,*.bmp;*.dib,Joint Photographic (Experts) Group,*.jpg,Graphics Interchange File,*.gif,Icône,*.ico,Curseur fixe,*.cur,Métafichiers,*.emf;*.wmf, Title:="Charger image")
   If Va <> False Then
      Z = Va: Mid$(Z, DernierDans(Z, "\"), 1) = vbLf
      Me.[RéfFicEnt].Value = Z
      ChargerImage
      Cells(1, 1).Select
      End If

Option Explicit
Rem. Conventions API (Application Programming Interface)
Type BITMAP
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
End Type
Private Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type
Private Declare Function GetObjectType Lib "gdi32.dll" (ByVal hgdiobj As Long) As Long
Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" _
   (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" _
   (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetDIBColorTable Lib "gdi32.dll" _
   (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pRGBQuad As RGBQUAD) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
   
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
   (Destination As Any, Source As Any, ByVal L As Long)

Dim ChNomF As String, LgL As Long, NbCoul As Long, LgE As Long, LgM As Long, LgF As Long
Dim Oct As Byte, BitPx As Integer, Succès As Boolean
'

Sub ChargerImage()
ChNomF = Replace(Images.[RéfFicEnt].Value, vbLf, "\")
If Dir(ChNomF) = "" Then
   MsgBox ChNomF & " inexistant", vbCritical, "Chargement de l'image": Exit Sub: End If
With Images.Image1
   .Left = Images.[PlgImg1].Left: .Width = Images.[PlgImg1].Width: .Top = Images.[PlgImg1].Top: .Height = Images.[PlgImg1].Height
   On Error Resume Next
   .Picture = LoadPicture(ChNomF)
   If Err Then MsgBox Err.Description, vbCritical, "Chargement de l'image": Exit Sub
   On Error GoTo 0: End With
Succès = ImageChargéeParAPI
If Not Succès Then ChargerImageBMP
If Succès Then
   Réglage.[XbmMax].Value = XbmMax
   Réglage.[YbmMax].Value = YbmMax: End If
OnAÉRVB = False: OnAEHJ = False
End Sub
'

Sub ÉcritureImage()
ChNomF = Replace(Images.[RéfFicSor].Value, vbLf, "\")
Succès = FichierProduitParAPI
If Not Succès Then ÉcrireFichierBMP
If Succès Then
   With Images.Image2
      .Left = Images.[PlgImg2].Left: .Width = Images.[PlgImg2].Width: .Top = Images.[PlgImg2].Top: .Height = Images.[PlgImg2].Height
      .Picture = LoadPicture(ChNomF)
      End With
   End If
End Sub
'

Function ImageChargéeParAPI() As Boolean
Dim bmAPI As BITMAP, AdresseMap As Long, TbOct() As Byte, Planes As Integer
Dim hDC As Long, NbCoul As Integer, Pal(0 To 255) As RGBQUAD, hObjectOld As Long, N°Coul As Integer
Tâche "Chargement de l'image (plan A)"
hDC = GetObjectType(Images.Image1.Picture)
If hDC <> 7 Then
   AbandonTâche "type d'image inapproprié"
   MsgBox "L'objet de type " & Array("nul", "PEN", "BRUSH", "DC", "METADC", "PAL", "FONT", "BITMAP", "REGION", _
      "METAFILE", "MEMDC", "EXTPEN", "ENHMETADC", "ENHMETAFILE", "COLORSPACE")(hDC) & " ne peut être traité.", _
   vbExclamation, NomTâche
   ImageChargéeParAPI = False: Exit Function: End If
If GetObject(Images.Image1.Picture, Len(bmAPI), bmAPI) = 0 Then
   AbandonTâche "information d'image non disponible"
   MsgBox "Impossible d'analyser cette image", vbExclamation, NomTâche
   ImageChargéeParAPI = False: Exit Function: End If
With bmAPI
   XbmMax = .bmWidth: YbmMax = .bmHeight: LgL = .bmWidthBytes
   Planes = .bmPlanes: BitPx = .bmBitsPixel: AdresseMap = .bmBits: End With
ReDim PxBrut(1 To 3, 1 To XbmMax, 1 To YbmMax) As Byte
ReDim TbOct(1 To LgL * YbmMax) As Byte
MoveMemory TbOct(1), ByVal AdresseMap, UBound(TbOct)
Tâche , XbmMax * YbmMax
If BitPx = 24 Then
   For X = 1 To XbmMax: For Y = 1 To YbmMax
      For C = 1 To 3: PxBrut(C, X, Y) = TbOct(3 * (X - 1) + LgL * (YbmMax - Y) + C): Next C
      Call OùÇaEnEst: Next Y: Next X
   ImageChargéeParAPI = True
ElseIf BitPx = 8 Or BitPx = 4 Then
   hDC = CreateCompatibleDC(0)
   hObjectOld = SelectObject(hDC, Images.Image1.Picture)
   If GetDIBColorTable(hDC, 0, 256, Pal(0)) = 0 Then
      AbandonTâche "palette inaccessible"
      MsgBox "La palette de couleur de cette image " & BitPx & " bits / pixel est inaccessible", _
         vbExclamation, NomTâche
      ImageChargéeParAPI = False: Exit Function: End If
   For X = 1 To XbmMax: For Y = 1 To YbmMax
      If BitPx = 8 Then
         N°Coul = TbOct(X + LgL * (YbmMax - Y))
      Else
         N°Coul = TbOct((X + 1) \ 2 + LgL * (YbmMax - Y))
         If X And &H1 Then N°Coul = N°Coul \ 16 Else N°Coul = N°Coul And &HF
         End If
      With Pal(N°Coul)
         PxBrut(1, X, Y) = .rgbBlue
         PxBrut(2, X, Y) = .rgbGreen
         PxBrut(3, X, Y) = .rgbRed: End With
      Call OùÇaEnEst: Next Y: Next X
   SelectObject hDC, hObjectOld 'Obligatoire parce que c'est comme ça.
   DeleteDC hDC
   ImageChargéeParAPI = True
ElseIf BitPx = 16 Then
   AbandonTâche "format non supporté"
   MsgBox "Image 16 bits / pixel non supportée." & vbLf _
      & "Remarque: Vérifiez les paramètres de l'affichage Windows.", vbExclamation, NomTâche
   ImageChargéeParAPI = False
Else
   AbandonTâche "format non supporté"
   MsgBox "Image " & BitPx & " bits / pixel non supportée.", vbExclamation, NomTâche
   ImageChargéeParAPI = False: End If
End Function

Necessite une feuile de Codename="Images" contenant une plage nommée "RéfFicEnt" et un contrôle image nommé "Image1"
Bon courage.

 

[SERIEUXETCOOL]

Re : Réaliser une matrice avec Excel

Bien après avoir essayé de triturer les bouts de codes que tu propose Dranreb, je ne suis pas parvenu à faire grand chose au final

Ne serait il pas possible d'envoyer un fichier Excel plutôt que des bouts de codes ?

Je peine à assembler le code pour commencer. Donc ça pars mal je pense.

Je vais continuer un peu mais je nage pour le coup.

Merci en tout cas d'avoir proposé ces bouts de codes. Je vais essayer de m'en inspirer.

Une question, ou se charge la photo au final ? Dans un classeur, un userform etc ?

André

 

[SERIEUXETCOOL]

Re : Réaliser une matrice avec Excel

Bon ça m'a donné mal au crâne d'essayer toutes ces choses.

Au final je n'ai même pas réussi à charger une image dans une picturebox. Rien absolument rien lol.

Je vais prendre une aspirine tiens...


Dranreb, aurais tu un fichier Excel qui donne en exemple la procédure pour charger proprement et simplement une photo d'un répertoire dans une picturebox ?
Je suis débutant en vba, mais il me semble tout de même que pour réaliser cette opération, quelques lignes de code suffisent. Je me trompe ?

Le classeur doit avoir un bouton de commande qui permet d'aller charger une image présente sur l'ordi,
Cette image doit se charger et afficher dans un picturebox.

Le truc de base quoi^^

Si vous avez des liens je suis preneur. Je ne trouve pas grand chose sur le net pour m'améliorer sur ce sujet.

 

[Dranreb]

Re : Réaliser une matrice avec Excel

Voilà.
Sélectionnez la référence du fichier en haut. J'ai préféré un contrôle Image, plus pratique grâce à sa propriété PictureSizeMode.
À +

 

[SERIEUXETCOOL]

Re : Réaliser une matrice avec Excel

Salut Dranreb, le Forum,

Dranreb j'ai apprécié ton fichier Excel !!! C'est exactement le début que j'espérais. En plus j'ai regardé le code et il ne comprend qu'une petite dizaine de ligne. C'est idéal pour comprendre comment ça marche.

Au premier abord le code ne semble pas bien simple tout de même. Mais je vais m'y plonger ce soir. Comme ça je serai capable moi aussi d'ouvrir des images dans un contrôle image. Indispensable pour débuter.

Un grand merci à toi car je ne pense pas que j'aurais trouvé seul.


Si tu veux bien m'aider encore un peu Dranreb, la suite consisterait à placer quelques point sur l'image qui est chargée. Une fois les points placés sur la photo, j'aimerais en extraire les coordonnées en R, G, B. Le tout serai affiché dans une feuille Excel.

Les points sont placés sur la photo par l'utilisateur. Je renseigne les coordonnées du pixel en question. On peut donc imaginer que sur une feuille vierge du classeur je place dans la colonne A les coordonnées X de mes pixels, dans la colonne B les coordonnées Y de mes pixels. Dans la colonne C, D et E on viens ajouter les coordonnées R,G,B de chaque pixel choisit par l'utilisateur.

Pour commencer ce test, on peut choisir 4 points définis comme suit :

A(10,40), B(50,40), C(10,100) et D(50,100). Quels sont donc les composantes R,G,B de ces pixels ?


Bien cordialement,

André


Ps : Je me rends compte que j'ai oublié de répondre as une de tes questions, qui est très importante !!! Je rectifie donc le tir.

P.S. Quelle est donc la vraie finalité de tout cela ? Il me semble qu'une plage décrivant des valeurs de pixels est assez illisible, c'est donc en vue d'autre chose que vous le voulez, mais quoi ? Il y a de forte chance que l'information ultime désirée se calculera plus aisément et rapidement en VBA qu'avec des formules.
Que représentent au départ vos images et que voulez vous mettre en évidence à l'arrivée ?
À +

Je vais essayé d'y répondre. Mes images représentent TOUTES la même forme circulaire d'un objet. Les seules choses qui varient sur les images sont : La position centrale du cercle (le cercle se décale d'une photo à une autre de manière aléatoire), le diamètre du cercle, et les couleurs qui composent l'image.
En gros mon image est colorée avec diverses teintes. Du rouge, du vert, du jaune, tu bleu, etc. Chaque couleur représente une épaisseur de film d'huile. On parle la d'interférométrie optique. Du coup je veux pouvoir ouvrir une photo, placer des points suivant les coordonnées que j'ai décidé et en extraire les composantes R,G,B du pixel. Ensuite je veux convertir les pixels R,G,B en HSI pour obtenir des HUE (You, teinte).
C'est à partir de la que je peux convertir mes HUE en épaisseur de film d'huile.

Suis-je clair ou as tu des questions complémentaires Draneb ? N'hésites surtout pas ! Si ça peut aider au développement du code