Conversion hectare, acre, metre pour l'achat d'un terrain

Soyez le premier à donner votre avis sur cette source.

Vue 82 031 fois - Téléchargée 415 fois

Description

Un jour me voila avec l'idée en tete de m'acheter une terre, puis apres m'avoir foulé un doigt sur ma calculette, j'ai créer ceci

Source / Exemple :


Private Sub dimension_Change()
On Error Resume Next
If dimension.Text = "" Then
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
End If
Call Calcul
End Sub

Private Sub Label12_Click()
On Error Resume Next
Dim a
Dim b
Dim c
Dim d
Dim e
Dim f
Dim ret
a = prix.Text / 4
f = prix.Text - a
b = f / 60
c = f / 120
d = f / 180
e = f / 300
a = Round(a, 2)
b = Round(b, 2)
c = Round(c, 2)
d = Round(d, 2)
e = Round(e, 2)
 ret = MsgBox(a & "$   de cash" & vbCrLf & vbCrLf & b & "$ /mois pour 5 ans" & vbCrLf & c & "$ /mois pour 10 ans" & vbCrLf & d & "$ /mois pour 15 ans" & vbCrLf & e & "$ /mois pour 25 ans", vbInformation, "25% de depot")
End Sub

Private Sub Option1_Click(Index As Integer)
Call Calcul
End Sub

Private Sub prix_Change()
On Error Resume Next
If prix.Text = "" Then
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
End If
Call Calcul
End Sub

Private Sub Text1_Change()
On Error Resume Next
Text1.Text = Round(Text1.Text, 6)
End Sub

Private Sub Text10_Change()
On Error Resume Next
Text10.Text = Round(Text10.Text, 6)
End Sub

Private Sub Text2_Change()
On Error Resume Next
Text2.Text = Round(Text2.Text, 6)
End Sub

Private Sub Text3_Change()
On Error Resume Next
Text3.Text = Round(Text3.Text, 6)
End Sub

Private Sub Text4_Change()
On Error Resume Next
Text4.Text = Round(Text4.Text, 6)
End Sub

Private Sub Text5_Change()
On Error Resume Next
Text5.Text = Round(Text5.Text, 6)
End Sub

Private Sub Text6_Change()
On Error Resume Next
Text6.Text = Round(Text6.Text, 6)
End Sub

Private Sub Text7_Change()
On Error Resume Next
Text7.Text = Round(Text7.Text, 6)
End Sub

Private Sub Text8_Change()
On Error Resume Next
Text8.Text = Round(Text8.Text, 6)
End Sub

Private Sub Text9_Change()
On Error Resume Next
Text9.Text = Round(Text9.Text, 6)
End Sub

Private Sub Calcul()
On Error Resume Next

If Option1(0).Value = True Then
Text1.Text = dimension.Text
Text2.Text = dimension.Text * 0.0929
Text3.Text = Text2.Text / 3418.89
Text4.Text = Text2.Text / 4047
Text5.Text = Text2.Text / 10000
End If

If Option1(1).Value = True Then
Text1.Text = dimension.Text * 10.76
Text2.Text = dimension.Text
Text3.Text = Text2.Text / 3418.89
Text4.Text = Text2.Text / 4047
Text5.Text = Text2.Text / 10000
End If

If Option1(2).Value = True Then
Text3.Text = dimension.Text
Text2.Text = dimension.Text * 3418.89
Text1.Text = Text2.Text * 10.76
Text4.Text = Text2.Text / 4047
Text5.Text = Text2.Text / 10000
End If

If Option1(3).Value = True Then
Text4.Text = dimension.Text
Text1.Text = dimension.Text * 4047 * 10.76
Text2.Text = dimension.Text * 4047
Text3.Text = Text2.Text / 3418.89
Text5.Text = Text2.Text / 10000
End If

If Option1(4).Value = True Then
Text5.Text = dimension.Text
Text1.Text = dimension.Text * 10000 * 10.76
Text2.Text = dimension.Text * 10000
Text3.Text = Text2.Text / 3418.89
Text4.Text = Text2.Text / 4047
End If
Text6.Text = prix / Text1.Text
Text7.Text = prix / Text2.Text
Text8.Text = prix / Text3.Text
Text9.Text = prix / Text4.Text
Text10.Text = prix / Text5.Text
End Sub

Codes Sources

Ajouter un commentaire Commentaires
Messages postés
56
Date d'inscription
jeudi 26 décembre 2002
Statut
Membre
Dernière intervention
28 septembre 2005

mais j'avais un doigt foulé
quand meme
Messages postés
56
Date d'inscription
jeudi 26 décembre 2002
Statut
Membre
Dernière intervention
28 septembre 2005

merci du conseil, c'est vrai que j'aurais du apercevoir ceci, j'suis encore débutant
Messages postés
222
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
30 juin 2008

Les :

Private Sub Text8_Change()
On Error Resume Next
Text8.Text = Round(Text8.Text, 6)
End Sub

Private Sub Text9_Change()
On Error Resume Next
Text9.Text = Round(Text9.Text, 6)
End Sub

Pourrais très bien être remplacés par :

Private Sub Texte_Change(Index As Integer)
On Error Resume Next
Texte(Index).Text = Round(Texte(Index).Text, 6)
End Sub

En une seule procédure. Il faut juste créer un groupe de contrôles (créer la 1ière boite de texte, mettre la prop index à 0, faire copier, coller cette boite de texte...). Il faut Optimiser.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.