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

Fermé
laurytk Messages postés 3 Date d'inscription vendredi 27 novembre 2015 Statut Membre Dernière intervention 29 novembre 2015 - Modifié par laurytk le 27/11/2015 à 16:45
laurytk Messages postés 3 Date d'inscription vendredi 27 novembre 2015 Statut Membre Dernière intervention 29 novembre 2015 - 29 nov. 2015 à 22:09
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
A voir également:

2 réponses

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
28 nov. 2015 à 22:00
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

0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié par Patrice33740 le 28/11/2015 à 22:34
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
0
laurytk Messages postés 3 Date d'inscription vendredi 27 novembre 2015 Statut Membre Dernière intervention 29 novembre 2015
28 nov. 2015 à 22:42
Bonjour et merci
Mais avec cette fonction nouvelle je n'arrive pas faire entre la valeurs à calculer
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié par Patrice33740 le 28/11/2015 à 22:53
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
0
laurytk Messages postés 3 Date d'inscription vendredi 27 novembre 2015 Statut Membre Dernière intervention 29 novembre 2015 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
29 nov. 2015 à 22:09
oui merci beaucoup..merci merci
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
29 nov. 2015 à 21:57
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
0