Modification de programme vbq de calcul en base 2 à la base 7

J'ai taper une fonction qui permet de calculer un nombre en base. Le programme fonctionne mais j'aimerais si possible la modifié pour que le calcul se fasse en base 7. Pouvez vous m'aidez s'il vous plaît. Merci
Le programme:
Sub Transforerunnombreenbase2()
Dim nbre_10 As Integer
Dim nbre_2 As Long
Dim Aux As Long
Dim P As Single
Dim Pmax As Byte
Dim T() As Byte
Dim N As Byte
Dim i As Byte

nbre_10 = CInt(InputBox("donner la valeur du chiffre décimal que vous vouler changer en base 2,", "question", "124"))
reste = nbre_10
Aux = 0
P = 0
nbre_2 = 0
i = 1
While reste >= Aux
Aux = 2 ^ P
If Aux > reste Then
Pmax = P - 1
End If
P = P + 1
Wend
P = Pmax
N = Pmax + 1
ReDim T(1 To N) As Byte

While reste > 0
Aux = 2 ^ P
P = P - 1
If reste >= Aux Then
reste = reste - Aux
T(i) = 1
Else
T(i) = 0
End If
Worksheets("Feuil1").Cells(3, i + 1).Value = T(i)
i = i + 1
Wend
While P >= 0
P = P - 1
Worksheets("Feuil1").Cells(3, i + 1).Value = 0
i = i + 1
Wend
P = Pmax
For i = 1 To N
nbre_2 = nbre_2 + T(i) * 10 ^ P
P = P - 1
Next i
Worksheets("Feuil1").Cells(3, i + 1).Value = 2
Call MsgBox("la valeur de" & nbre_10 & "de la base 10 est transformé en" & nbre_2 & "en base 2", 0, "réponse")

End Sub

2 réponses

  1. Contributeur
    Bonjour,

    J'arrive en retard mais comme j'avais fait un travail de fonction, similaire à Patrice33740 (que je salue), utilisé par un formulaire, j'ai réuni les différentes macro avec ta macro initiale et voici le classeur :

    https://www.cjoint.com/c/EKDu3Ia21wl
    1. Bonjour,

      Essaies ce code :
      Sub test()
        MsgBox Base10versAutreBase(49, 7)
      End Sub
      Function Base10versAutreBase(Nombre As Long, Base As Byte) As String
        If Base > 9 Then
          Base10versAutreBase = "La base doit être inférieure à 10"
          Exit Function
        End If
        If Int(Nombre / Base) = 0 Then
          Base10versAutreBase = CStr(Nombre Mod Base)
        Else
          Base10versAutreBase = _
            Base10versAutreBase(Int(Nombre / Base), Base) & _
            CStr(Nombre Mod Base)
        End If
      End Function

      1. Ou encore pour convertir dans les bases 2 à 36 :
        Sub test()
          MsgBox Base10versAutreBase(49, 7)
        End Sub
        Function Base10versAutreBase(Nombre As Long, Base As Byte) As String
        Dim x As String
        Dim r As Byte
          If Base < 2 Or Base > 36 Then
            Base10versAutreBase = "La base doit être entre 2 et 36 inclus"
            Exit Function
          End If
          x = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
          r = Nombre Mod Base
          If Int(Nombre / Base) = 0 Then
            Base10versAutreBase = Mid(x, r + 1, 1)
          Else
            Base10versAutreBase = _
              Base10versAutreBase(Int(Nombre / Base), Base) & Mid(x, r + 1, 1)
          End If
        End Function
      2. Bonjour et merci
        Mais avec cette fonction nouvelle je n'arrive pas faire entre la valeurs à calculer
      3. Par exemple remplace la Sub Test par :
        Sub test()
        Dim nbre_10 As Long
        Dim base As Byte
          base = 7
          nbre_10 = CInt(InputBox("donner la valeur du chiffre décimal que vous vouler changer, en base " & base, "question", "124"))
          MsgBox "Resultat: " & Base10versAutreBase(nbre_10, base)
        End Sub