FACTORIELLE

Sub form_load()
    resultat.Text = ""
    longueur.Caption = ""
    progression.Visible = False
    progression.Value = 0
End Sub
Sub calfact()
    Dim reg() As Double
    Dim n As Double
    Dim nb_reg As Double
    Dim i As Double
    Dim j As Double
    progression.Visible = True
    progression.Value = 0
    longueur.Caption = ""
    resultat.Text = ""
    titre = "Saisie."
retour_fact:
    'Saisie du nombre
    valeur = InputBox("Valeur de n =", titre, 70)
    If valeur = "" Then Exit Sub
    n = Val(valeur)
    'Test si n entier
    If n <> Int(n) Then
        titre = "n doit être entier !!!"
        Beep
        GoTo retour_fact
    End If
    'Calcul et affichage de la longueur de la factorielle (propriété des log => log(a*b)=log(a)+log(b))
    nb_reg = 0
    For i = 1 To n
        nb_reg = nb_reg + log10(i)
    Next i
    longueur.Caption = n & " ! comprend " & Int(nb_reg + 1) & " chiffres."
    DoEvents
    'initialisations des registres
    taille_reg = 10
    nb_reg = Int(Int(nb_reg + 1) / taille_reg) + 1
    ReDim reg(nb_reg + 1)
    'Mise à 1 du 1er registre sinon n!=0
    reg(1) = 1
    'nb de registre concerné par le calcul=1
    nr = 1
    'Début de calcul
    For i = 1 To n
        DoEvents
        progression.Value = Int(100 * i / n)
        retenue = 0
        j = 1
        While j <= nr
            reg(j) = reg(j) * i + retenue
            retenue = Int(reg(j) / 10 ^ (taille_reg))
            reg(j) = reg(j) - retenue * 10 ^ (taille_reg)
            'test de la retenue, si <>0 alors ajout d'un registre pour propagation de la retenue
            If retenue <> 0 And j = nr Then nr = nr + 1
            j = j + 1
        Wend
    Next i
    affichage = ""
    For k = 1 To nb_reg
        t = Trim(Str(reg(nb_reg + 1 - k)))
        If (nb_reg + 1 - k) = nb_reg Then GoTo aff
        If t = "" Or t = "0" Then t = "0000000000"
        If Len(t) < 10 Then
            For m = 1 To 10 - Len(t)
                t = "0" + t
            Next m
        End If
aff:
        affichage = affichage + t
    Next k
    resultat.Text = affichage
    progression.Value = 0
    progression.Visible = False
End Sub
Function log10(x As Double) As Double
    log10 = Log(x) / Log(10)
End Function
Private Sub Command1_Click()
    calfact
End Sub

Télécharger le zip