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
A voir également:
- Modification de programme vbq de calcul en base 2 à la base 7
- Base de registre - Guide
- Photofiltre 7 - Télécharger - Retouche d'image
- Suivi de modification word - Guide
- Clé de produit windows 7 - Guide
- Supercopier 2 - Télécharger - Gestion de fichiers
2 réponses
Bonjour,
Essaies ce code :
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
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
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
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 FunctionMais avec cette fonction nouvelle je n'arrive pas faire entre la valeurs à calculer
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