Modification de programme vbq de calcul en base 2 à la base 7
laurytk
Messages postés
3
Statut
Membre
-
laurytk Messages postés 3 Statut Membre -
laurytk Messages postés 3 Statut Membre -
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
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
-
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
-
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 -
-
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
-
-
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
