Bonjour à tous,
Je suis novice en VBA. En effet, j'ai découverts ce langage de programmation à travers un cours à l'école.. bref, passons. Je n'est pas trouvé de post répondant à mon souci, alors voici mon problème:
Il s'agit d'un problème de bin packing. Si comme moi vous n'aviez jamais entendu parler de cet animal, voici l'énoncé: Il s'agit de placer une liste d’objets (ici des rectangles de différentes tailles) dans le plus petit nombre d’espace de rangements (nommé Bin, un rectangle plus grand que les autres de hauteur et largeur connus) possible. Le problème se limite à 2 dimensions : hauteur et largeur. La méthode préconisée par le prof est celle du Best Fit Decreasing High (BFDH).

Je procède donc de la maniere suivante:
1 - je trie les rectangles par hauteur décroissante et largeur décroissante.
2 - Je construis des niveaux, cela correspond à la 1° étape du BFDH: je place un maximum de rectangle dans chaque niveau. La largeur des niveaux est égale à celle d'un bin et la hauteur est égale à celle du premier rectangle de chaque niveau.
3 - Je calcule le nombre de bins nécessaire pour placer tous mes niveaux, c'est l'étape n° 2 du BFDH: La hauteur des bins étant connue, il faut placer chaque niveau dans les bin de telle sorte que la place résiduelle en hauteur soit minimum.
4 - J'affiche la solution.

J'ai terminé les opérations 1 à 3 (bien que je ne sache pas si les 2 et 3 soit optimisées ou non, mais c'est une autre histoire). Je cale sur la 4°!! J'affiche le nombre de bins qu'il me faut ainsi que les rectangles dans chaque bin, rangés par niveaux. Mais mon soucis est le suivant : Les niveaux à l'intérieur de chaque bin sont superposés les uns sur les autres au lieu d'être repartis sur la hauteur de chaque bin ( compris?? ).

Pour parvenir à l'affichage de ma solution finale, je dois donc afficher dans chaque bin les niveaux qui lui sont affectés. Je ne parviens pas à calculer l'ordonnée du coin supérieur gauche des rectangles en tenant compte de la hauteur du bin, de la hauteur du niveau concerné et celle des éventuels niveaux déjà affectés à ce bin! ( je sens que je vous ai perdu... )
Je n'ai pas de soucis pour l'abscisse.

Voici mon code, je pense que cela vous aidera plus que mes explications! (Je précise que certaine partie du code, notamment comment créer une forme automatique avec sa couleur, m'a été fourni par le prof. Mais il n'y a aucun caractère confidentiel)

en feuille 1:

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
'-----------------------------------------------------------------------------------------
' Procedure de rangement par BFDH
'-----------------------------------------------------------------------------------------
Private Sub BFDH_Click()
 
Dim NomFic As String
 
' Lecture d'un fichier
LireBinPacking NomFic
 
' Afficher le nom du fichier lu
TextBox1.Text = NomFic
 
'Triage par hauteur et largeur décroissante
TriRect
 
'Rangement par BFDH
rangementBFDH
 
End Sub

en Module 1:

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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
'-----------------------------------------------
'---------Lire un jeu de rectangles----------
'-----------------------------------------------
 
Public Sub LireBinPacking(NomFic As String)
Dim fileToOpen As String
Dim i As Integer, j As Integer, wi As Integer, hi As Integer, ni As Integer
 
' Ouverture du dialogue standard de lecture de fichier avec filtre "texte"
fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> "Faux" Then
    Open fileToOpen For Input As #1
 
    ' Rendre le nom du fichier
    NomFic = fileToOpen
 
    ' Lecture de la largeur des Bins
    Input #1, W
 
    ' Lecture de la hauteur des Bins
    Input #1, H
 
    ' Lecture du nombre de types de rectangles
    Input #1, NbTypesRect
 
    ' Lecture des informations des n tâches
    n = -1
    For i = 1 To NbTypesRect
        Input #1, wi: Input #1, hi: Input #1, ni
        For j = 1 To ni
            n = n + 1
            LRect(n).W = wi
            LRect(n).H = hi
        Next j
    Next i
    Close #1
End If
 
End Sub
 
'--------------------------------------------------------------------
'---------Procédure de tri par sélection du maximum----------
'--------------------------------------------------------------------
 
Public Sub TriRect()
 
'Déclarations des variables de tris
Dim i As Integer    'sert à selectionner une case du tableau des rectangles
Dim j As Integer    'sert à selectionner la case du tableau des rectangles immédiatement apres celle en i
Dim Max As Integer  'sert à stoquer la valeur max entre 2 cases du tableau
Dim k As Double     'sert à échanger le contenu de 2 cases
 
For i = 0 To n
    Max = i
    For j = i + 1 To n
    If LRect(j).H > LRect(Max).H Then Max = j
    If LRect(j).H = LRect(Max).H Then
        If LRect(j).W > LRect(Max).W Then Max = j
        End If
    Next j
    k = LRect(Max).H
    LRect(Max).H = LRect(i).H
    LRect(i).H = k
Next i
 
End Sub
 
'---------------------------------------------------------------------------
'--------------------Procedure de rangement par BFDH------------------------
'---------------------------------------------------------------------------
 
'---------------------------------------------------------------------------
'1°/ Creation de niveaux de largeur égale aux bins ou l'on range un maximum de rectangles
'2°/ Calcul du nombre de Bins necessaire en empillant un maximum de niveau par bins
'3°/ Affichage de la solution
'---------------------------------------------------------------------------
 
Public Sub rangementBFDH()
 
'-------------------------
'construction des niveaux
'-------------------------
 
Dim i As Integer
Dim j As Integer
Dim Nbr As Integer
 
'initialisation des niveaux
For i = 0 To n
    LNiv(i).Nbr = 0
    LNiv(i).PlaceResid = W
Next i
 
'initialisation du nombre de niveaux
Nniv = 0
 
'Placement dans les niveaux
For i = 0 To n
    j = 0
        While LRect(i).W > LNiv(j).PlaceResid
        j = j + 1
        Wend
 
    ' définition de la hauteur du niveau
    If LNiv(j).Nbr = 0 Then LNiv(j).H = LRect(i).H: Nniv = Nniv + 1
 
    'Mettre a jour la liste LRect
 
    LRect(i).b = j                                                     ' indice du niveau ds lequel sera le rectangle
    LRect(i).L = W - LNiv(j).PlaceResid                                ' abscisse du rectangle pour le placement dans le niveau
    LRect(i).T = LNiv(j).H - LRect(i).H                                ' Ordonnee du rectangle pour le placement dans le niveau
 
    'Mettre a jour le niveau
    Nbr = LNiv(j).Nbr
    Nbr = Nbr + 1
    LNiv(j).Nbr = Nbr                                                  'Nb de rect dans le niveau
    'LNiv(j).LR(Nbr) = i                                                'indice de rangement du dernier rect dans le niveau (utile??)
    LNiv(j).PlaceResid = LNiv(j).PlaceResid - LRect(i).W               'place restante apres le dernier rectangle
Next i
 
    ' Mettre a jour le nombre de niveau a l'interface
    Feuil1.NbNiv.Text = Nniv
 
 
 
'Affiche les niveaux
AfficheNiveaux
 
 
'-------------------------
'calcul des bins
'-------------------------
 
'initialisation des bins
For i = 0 To n
    LBins(i).Nbr = 0
    LBins(i).PlaceresidH = H
Next i
 
'initialisation du nombre de bins
Nbin = 0
 
'Placement dans les bin
For i = 0 To Nniv
    j = 0
        While LNiv(i).H > LBins(j).PlaceresidH
        j = j + 1
        Wend
 
    ' calcul du nombre de bin
    If LBins(j).Nbr = 0 Then Nbin = Nbin + 1
 
    'mettre a jour la liste LNiv
    LNiv(i).b = j                                                      ' indice du bin ds lequel sera le niveau
    LNiv(i).L = W - LBins(j).PlaceResid                                ' abscisse du niveau pour le placement dans le bin
    LNiv(i).T = H - LNiv(i).H                                          ' Ordonnee du niveau pour le placement dans le bin
    'mettre a jour le bin
    Nbr = LBins(j).Nbr
    Nbr = Nbr + 1
    LBins(j).Nbr = Nbr                                                 'Nb de niveau dans le bin
    LBins(j).LN(Nbr) = i                                               'indice de rangement du dernier niveau dans le tableau
    LBins(j).PlaceresidH = LBins(j).PlaceresidH - LNiv(i).H            'place restante en hauteur apres le dernier niveau
Next i
 
' Mettre a jour le nombre de niveau a l'interface
Feuil1.NbBin.Text = Nbin
 
'-------------------------
'Affichage des bins
'-------------------------
 
 
Dim x As Integer, y As Integer
Dim Rg(NbC) As Integer, Gr(NbC) As Integer, Bl(NbC) As Integer  ' couleurs des rectangles
Dim dx As Integer, Cx As Integer, Cy As Integer, j1 As Integer
Dim Binx As Integer, Biny As Integer
 
' Création d'une table de couleurs
Rg(0) = 255:  Gr(0) = 255:   Bl(0) = 0
Rg(1) = 0:    Gr(1) = 255:   Bl(1) = 255
Rg(2) = 0:    Gr(2) = 255:   Bl(2) = 0
Rg(3) = 224:  Gr(3) = 146:   Bl(3) = 47
Rg(4) = 97:   Gr(4) = 189:   Bl(4) = 240
Rg(5) = 51:   Gr(5) = 164:   Bl(5) = 87
Rg(6) = 214:  Gr(6) = 109:   Bl(6) = 123
Rg(7) = 154:  Gr(7) = 123:   Bl(7) = 85
Rg(8) = 255:  Gr(8) = 0:     Bl(8) = 0
Rg(9) = 255:  Gr(9) = 0:     Bl(9) = 255
Rg(10) = 167: Gr(10) = 159:  Bl(10) = 34
Rg(11) = 133: Gr(11) = 128:  Bl(11) = 186
 
' Afficher le dernier indice des rectangles maximaux créés
' Range("H14").Value = nRMax
 
' Affichage des bins vides
x = 900: y = 200
For i = 0 To Nbin
    If (LBins(i).Nbr > 0) Then
        ' Conserver la position du bin
        LBins(i).x = x
        LBins(i).y = y
        With ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, W, H)
            .Fill.ForeColor.RGB = RGB(200, 200, 200)
            .Line.Weight = 1
            .Line.ForeColor.RGB = RGB(0, 0, 0)
        End With
        ' Calculer le futur emplacement de Bin
        x = x + W + 10
        If (x > 1500) Then
            x = 900: y = y + H + 10
        End If
    End If
Next i
 
' Affichage de la solution
For i = 0 To n
    Binx = LBins(LNiv(LRect(i).b).b).x: Biny = LBins(LNiv(LRect(i).b).b).y              'abscisse et ordonnée de chaque bins
    x = LRect(i).L: y = H - LRect(i).H - LNiv(LBins(LNiv(j).b).LN(j)).H                                    '    x = LNiv(LRect(i).b).L: y = LNiv(LRect(i).b).T
    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Binx + x, Biny + y, LRect(i).W, LRect(i).H)
        .Fill.ForeColor.RGB = RGB(Rg(i Mod NbC), Gr(i Mod NbC), Bl(i Mod NbC))
        .Line.Weight = 1
        .Line.ForeColor.RGB = RGB(0, 0, 0)
    End With
Next i
 
End Sub

Voilà! Mon soucis se trouve dans la dernière partie " 'Affichage de la solution"

Je vous remercie d'avoir pris le temps de me lire, et de me proposer des pistes.

A+