Sub PresenterSolution()
Dim c As Object
Dim i As Integer, j As Integer
'Insérer le titre du tableau.
Sheets("Données").Select
Cells(BasTabD + 5, 1).Value = "Le tableau suivant décrit un plan optimal de transport."
Cells(BasTabD + 5, 1).Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial": .Size = 12: .Strikethrough = False
.Superscript = False: .Subscript = False: .OutlineFont = False
.Shadow = False: .Underline = xlUnderlineStyleNone: .ColorIndex = 3
End With
'Copier le tableau.
Range(Cells(DebTabD, 1), Cells(BasTabD + 1, DroiteTabD + 1)).Select
Selection.Copy
Cells(BasTabD + 6, 1).Select
ActiveSheet.Paste
If DispT > DemT Then
'Il faut insérer une colonne pour la destination fictive.
Range(Cells(BasTabD + 6, 1 + N), Cells(BasTabD + 6 + M + 1, 1 + N)).Select
Selection.Cut
Cells(BasTabD + 6, 2 + N).Select
ActiveSheet.Paste
Range(Cells(BasTabD + 6, 3), Cells(BasTabD + 6 + M + 1, 3)).Select
Selection.Copy
Cells(BasTabD + 6, 1 + N).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells(BasTabD + 6, 1 + N).Value = "Disp. résiduelle"
Cells(1, 1 + N).Select
Selection.ColumnWidth = 14.57
Cells(BasTabD + 6 + M + 1, 1 + N).Value = DispT - DemT
End If
If DemT > DispT Then
'Il faut insérer une ligne pour l'origine virtuelle.
Cells(BasTabD + 6 + M, 1).Select
Selection.EntireRow.Insert
Range(Cells(BasTabD + 6 + M - 2, 1), Cells(BasTabD + 6 + M - 2, 2 + N)).Select
Selection.Copy
Range(Cells(BasTabD + 6 + M - 1, 1), Cells(BasTabD + 6 + M - 1, 2 + N)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells(BasTabD + 6 + M, 1).Value = "Dem. non satisfaite"
Cells(BasTabD + 6 + M, 2 + N).Value = DemT - DispT
End If
'Insérer la valeur dans le coin inférieur droit.
Cells(BasTabD + 7 + M, 2 + N).Value = Application.WorksheetFunction.Max(DemT, DispT)
Cells(BasTabD + 7 + M, 2 + N).Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
'Insérer les valeurs optimales des variables.
i = 1: j = 1
For Each c In Range("xij")
Cells(BasTabD + 6 + j, 1 + i).Value = c.Value
Cells(BasTabD + 6 + j, 1 + i).Select
ActiveCell.NumberFormat = "0" 'Afficher avec 0 décimale.
If i = N Then
j = j + 1
i = 0
End If
i = i + 1
Next c
'Insérer la valeur optimale z* de la fonction-objectif.
Select Case (Sheets("Données").cboMaxMin.Value)
Case "Max"
Cells(BasTabD + 8 + M, 1).Select
ActiveCell.FormulaR1C1 = "Profit maximal : z* ="
Case "Min"
Cells(BasTabD + 8 + M, 1).Select
ActiveCell.FormulaR1C1 = " Coût minimal : z* ="
End Select
Cells(BasTabD + 8 + M, 1).Select
Selection.Font.Bold = True
Cells(BasTabD + 8 + M, 3).Value = Range("z").Value
Range(Cells(BasTabD + 8 + M, 1), Cells(BasTabD + 8 + M, 3)).Select
Selection.RowHeight = 18
Selection.Interior.ColorIndex = xlNone
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial": .Size = 12
End With
Cells(BasTabD + 8 + M, 3).Select
Selection.Font.ColorIndex = 3
With Selection
.HorizontalAlignment = xlCenter
End With
Cells(BasTabD + 8 + M, 3).Select
End Sub