PROGRAMME DE RÉSOLUTION DE N ÉQUATIONS À N INCONNUES

 Dim dec As Integer
Dim tabmat() As Double
Dim m As Integer
Dim var(), y(), temp(), ytemp() As Variant

Private Sub cmdgauss_Click()

m = Flexmat.Cols
ProgressBar1.Min = 0
ProgressBar1.Max = 100

If txtdec = "" Then dec = 20 Else dec = txtdec.Text

ReDim var(m), y(m), temp(m, m), ytemp(m)
Dim pgb As Double
ReDim tabmat(m, m) As Double
Dim a, maxp, maxs As Double

'a est le coeff de l'algorithme'
a = 1
colmax = 0
rowmax = 0
maxs = 0
maxp = 0
pgb = 99 / (7 * m - 5)

'remplissage du tableau'
For i = 0 To m - 1
flexvar.Row = i
Flexvarini.Row = i
flexvar.Text = Flexvarini.Text
    For j = 0 To m - 1
    Flexmat.Row = i
    Flexmat.Col = j
    tabmat(i, j) = Flexmat.Text
    Next j
Next i
ProgressBar1.Value = pgb

'''''''''''''''début de l'algorithme''''''''''''''''


'écriture dans flexresult'
For i = k To m - 1
    For j = k To m - 1
    temp(i, j) = tabmat(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

'écriture dans var()'
For i = 0 To m - 1
Flexvarini.Row = i
var(i) = Flexvarini.Text
Next i

'écriture dans y()'
For i = 0 To m - 1
flex_yini.Row = i
y(i) = flex_yini.Text
Next i

For k = 0 To m - 2

'recherche du maximum'
maxp = 0
For i = k To m - 1
    For j = k To m - 2
    maxs = Max(tabmat(i, j), tabmat(i, j + 1))
    If maxs > maxp Then maxp = maxs
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

'recherche de l'emplacement du maximum'
For i = k To m - 1
    For j = k To m - 1
        If temp(i, j) = maxp Then
        colmax = j
        rowmax = i
        End If
    Next j
Next i

suite:
ProgressBar1.Value = ProgressBar1.Value + pgb

'réécriture dans flexresult pour obtenir le pivot le plus grand'

'changement de la ligne'
For j = k To m - 1
    temp(k, j) = Round(tabmat(rowmax, j), dec)
    temp(rowmax, j) = Round(tabmat(k, j), dec)
Next j
ytemp(rowmax) = Round(y(k), dec)
ytemp(k) = Round(y(rowmax), dec)

ProgressBar1.Value = ProgressBar1.Value + pgb

'réécriture du tableau'
For i = k To m - 1
y(i) = ytemp(i)
    For j = k To m - 1
    tabmat(i, j) = temp(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

'changement de colonne'
For i = k To m - 1
    temp(k, i) = Round(tabmat(i, colmax), dec)
    temp(colmax, i) = Round(tabmat(i, k), dec)
Next i
flexvar.Row = k
flexvar.Text = var(colmax)
flexvar.Row = colmax
flexvar.Text = var(k)
ProgressBar1.Value = ProgressBar1.Value + pgb


'réécriture du tableau'
For i = k To m - 1
flexvar.Row = i
var(i) = flexvar.Text
flex_y.Row = i
flex_y.Text = ytemp(i)
    For j = k To m - 1
    Flexresult.Row = i
    Flexresult.Col = j
    Flexresult.Text = temp(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

For i = k + 1 To m - 1
    If tabmat(k, k) <> 0 Then
    a = tabmat(i, k) / tabmat(k, k) 'calcul de a'
    Else
    MsgBox "les équations ne sont pas indépendantes !", vbOKOnly, "erreur"
    Cmdresult.Enabled = False
    GoTo break
    End If
    y(i) = y(i) - (y(k) * a)
    flex_y.Row = i
    flex_y.Text = Round(y(i), dec)
    For j = k To m - 1
        Flexresult.Row = i
        Flexresult.Col = j
        tabmat(i, j) = tabmat(i, j) - (tabmat(k, j) * a)
        Flexresult.Col = j
        Flexresult.Row = i
        Flexresult.Text = Round(tabmat(i, j), dec)
    Next j
Next i
For i = 0 To m - 1
flex_y.Row = i
y(i) = flex_y.Text
    For j = 0 To m - 1
    tabmat(i, j) = temp(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb
Next k
'fin de l'agorithme'
ProgressBar1.Value = 0
For i = 0 To m - 1
    For j = 0 To m - 1
    tabmat(i, j) = temp(i, j)
    Next j
Next i
Cmdresult.Enabled = True
If tabmat(m - 1, m - 1) = 0 Then
MsgBox "Les équations ne sont pas indépendantes !", vbExclamation, "Matrice 1.0.0."
Cmdresult.Enabled = False
End If
break:
MsgBox "La matrice à été simplifiée pour permettre le calcul du résultat. cliquez sur 'resultat final' pour calculer les inconnus !", vbInformation, "Matrice 1.0.0."
End Sub

Private Sub cmdmodif_Click()
Flexmat.Text = InputBox("Rentrez la nouvelle valeur :", "Matrice 1.0.0.", 0, 2000, 200)
End Sub

Private Sub cmdrandom_Click()
Randomize
For i = 0 To m - 1
flex_yini.Row = i
flex_yini.Text = Round(20 * Rnd(20), 0)
    For j = 0 To m - 1
    Flexmat.Col = j
    Flexmat.Row = i
    Flexmat.Text = Round(20 * Rnd(20), 0)
    Next j
Next i
cmdmodif.Enabled = True
cmdsecond.Enabled = True
cmdgauss.Enabled = True
End Sub

Private Sub cmdremp_Click()
For i = 0 To m - 1
    For j = 0 To m - 1
    Flexmat.Col = j
    Flexmat.Row = i
    Flexmat.Text = InputBox("Veuillez rentrer la valeur de a(" & i & "," & j & ") :", "Matrice 1.0.0.", 0, 2000, 200)
    Next j
Next i
cmdmodif.Enabled = True
cmdsecond.Enabled = True
End Sub

Private Sub Cmdresult_Click()
Dim res() As Double
ReDim res(m)
Dim somme, val As Double
Dim j, kinv As Integer

'initialisation de res()'
For i = 1 To m - 1
res(i) = 0
Next i

'début de l'algorithme'
For k = 0 To m - 1
kinv = m - 1 - k

'somme des coeff.'
somme = 0
val = 0
j = m - 1
Do While j > kinv
    val = tabmat(m - 1 - k, j) * res(j)
    somme = somme + val
    j = j - 1
Loop
res(kinv) = (y(kinv) - somme) / tabmat(kinv, kinv)
Next k

'écriture des résultats'
For i = 0 To m - 1
flex_y.Row = i
flex_y.Text = Round(res(i), dec)
Next i

MsgBox "c'est fini!", vbInformation, "matrice 1.0.0."

End Sub

Private Sub cmdsecond_Click()
For i = 0 To m - 1
    flex_yini.Row = i
    flex_yini.Text = InputBox("variable " & i, "Matrice 1.0.0.", 0)
Next i
Cmdresult.Enabled = True
cmdgauss.Enabled = True
End Sub

Private Sub cmdvar_Click()
For i = 0 To m - 1
    Flexvarini.Row = i
    Flexvarini.Text = InputBox("variable " & i, "Matrice 1.0.0.", "x" & i)
Next i
End Sub

Private Sub Description_Click()
MsgBox "Ce programme permet de résoudre n équations à n inconnues. Il nécessite cependant une bonne connaissance de l'utilisation des matrices. ", vbInformation, "Matrice 1.0.0."
End Sub

Private Sub Form_Load()
Flexmat.FixedCols = 0
Flexmat.FixedRows = 0
Flexresult.FixedRows = 0
Flexresult.FixedCols = 0
m = 3
cmdgauss.Enabled = False
cmdmodif.Enabled = False
Cmdresult.Enabled = False
cmdsecond.Enabled = False
Call Rang_Click
End Sub

Private Sub Newmat_Click()
Flexmat.Clear
Flexresult.Clear
flex_yini.Clear
flex_y.Clear
flexvar.Clear
txtdec.Text = ""
Label1.Caption = ""
Cmdresult.Enabled = False
cmdmodif.Enabled = False
cmdgauss.Enabled = False
cmdsecond.Enabled = False
Call Rang_Click
End Sub

Private Sub Quitter_Click()
End
End Sub

Private Sub Rang_Click()
m = InputBox("Rang de la matrice carrée :", "Matrice 1.0.0. ", 3, 100, 200)
Flexmat.Cols = m
Flexmat.Rows = m
Flexresult.Cols = m
Flexresult.Rows = m
Flexvarini.Rows = m
flex_yini.Rows = m
flexvar.Rows = m
flex_y.Rows = m
For i = 0 To m - 1
    Flexvarini.Row = i
    Flexvarini.Text = "x" & i
Next i
End Sub

Private Sub Rng_Click()
Call Rang_Click
End Sub