[VBA Excel] Problème ComboBox et Function [Résolu]

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA Excel] Problème ComboBox et Function [Résolu]

mmarle

Bonjour,

Je viens de réaliser une petite interface qui me donne des ratios (Aménagement de surface en voirie: % de pavés par rapport au joints pour 1,00 m²).

Je dispose donc d'une Userform (munie de plusieurs ComboBox et TextBox) dans laquelle on peut trouver les instructions d'initialisation et de conditions puis un module dans lequel se trouve les function de calcul.

Le but de cette interface est donc de donner les ratios automatiquement dans les TextBox par le biais des "Function" une fois les valeurs choisies dans les ComboBox.

Le code fonctionne mais il subsiste une anomalie! pour certaines valeurs (dans les ComboBox) le calcul ne se fait pas et là je sèche complètement.

Voici le code:

Dans l'Userform:

Code :

Option Explicit
Dim i As Byte
Dim LargPav As Variant
Dim LongPav As Variant
Dim LargJoint As Variant
Dim Surf As Variant
Dim HautPav As Variant
Private Sub ComboBox1_Click()
If ComboBox1 <> "" Then
LargPav = Left(ComboBox1.Value, Len(ComboBox1.Value) - 3)
TextBox1.Value = CalcA(LargPav, LongPav, LargJoint)
TextBox2.Value = CalcB(LargPav, LongPav, LargJoint)
TextBox3.Value = ComboBox1.Value
Else
LargPav = ""
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
End If
End Sub
Private Sub ComboBox2_Click()
If ComboBox2 <> "" Then
LongPav = Left(ComboBox2.Value, Len(ComboBox2.Value) - 3)
TextBox1.Value = CalcA(LargPav, LongPav, LargJoint)
TextBox2.Value = CalcB(LargPav, LongPav, LargJoint)
TextBox4.Value = ComboBox2.Value
Else
LongPav = ""
TextBox1.Value = ""
TextBox2.Value = ""
TextBox4.Value = ""
End If
End Sub
Private Sub ComboBox3_Click()
If ComboBox3 <> "" Then
LargJoint = (Left(ComboBox3.Value, Len(ComboBox3.Value) - 3)) / 10
TextBox1.Value = CalcA(LargPav, LongPav, LargJoint)
TextBox2.Value = CalcB(LargPav, LongPav, LargJoint)
Else
HautPav = ""
TextBox1.Value = ""
TextBox2.Value = ""
End If
End Sub
Private Sub ComboBox4_Click()
If ComboBox4 <> "" Then
HautPav = Left(ComboBox4.Value, Len(ComboBox4.Value) - 3)
TextBox5 = ComboBox4.Value
TextBox7 = CalcC(LargPav, LongPav, LargJoint, Surf)
TextBox8 = CalcD(LargPav, LongPav, LargJoint, HautPav, Surf)
Else
HautPav = ""
TextBox7 = ""
TextBox8 = ""
End If
End Sub
Private Sub CommandButton1_Click()
Unload RatioBox
End Sub
Private Sub CommandButton2_Click()
MsgBox "LargPav= " & LargPav & Chr(10) & "LongPav= " & LongPav & Chr(10) & "LargJoint= " & LargJoint & Chr(10) & "HautPav= " & HautPav & Chr(10) & "Surf= " & Surf & Chr(10) & "CalcA= " & CalcA(LargPav, LongPav, LargJoint) & Chr(10) & "CalcB= " & CalcB(LargPav, LongPav, LargJoint) & Chr(10) & "CalcC= " & CalcC(LargPav, LongPav, LargJoint, Surf) & Chr(10) & "CalcD= " & CalcD(LargPav, LongPav, LargJoint, HautPav, Surf)
End Sub
Private Sub TextBox6_AfterUpdate()
TextBox6.Value = Format(TextBox6.Value, "#.00 m²" )
If TextBox6 <> "" Then
Surf = Left(TextBox6.Value, Len(TextBox6.Value) - 3)
TextBox7 = CalcC(LargPav, LongPav, LargJoint, Surf)
TextBox8 = CalcD(LargPav, LongPav, LargJoint, HautPav, Surf)
Else
Surf = ""
TextBox7 = ""
TextBox8 = ""
End If
End Sub
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem ""
End With
With ComboBox2
.AddItem ""
End With
For i = 5 To 100
'Initialisation Sections Pavé'
With ComboBox1
.AddItem Format(i, "#.00 cm" )
End With
'Initialisation Largeur Pavé'
With ComboBox2
.AddItem Format(i, "#.00 cm" )
End With
Next i
'Initialisation Largeur des Joints'
With ComboBox3
.AddItem ""
.AddItem "8 mm"
.AddItem "10 mm"
.AddItem "15 mm"
.AddItem "20 mm"
.AddItem "25 mm"
.AddItem "30 mm"
.AddItem "35 mm"
.AddItem "40 mm"
End With
'Initialisation Hauteur des Pavés'
With ComboBox4
.AddItem ""
.AddItem "6,00 cm"
.AddItem "8,00 cm"
.AddItem "14,00 cm"
.AddItem "20,00 cm"
End With
TextBox1.Enabled = False
TextBox2.Enabled = False
TextBox3.Enabled = False
TextBox4.Enabled = False
TextBox5.Enabled = False
TextBox7.Enabled = False
TextBox8.Enabled = False
End Sub

Dans un module:

Code :

Option Explicit
Function CalcA(LargPav, LongPav, LargJoint)
If LargPav And LongPav And LargJoint <> "" Then
CalcA = Format((LargPav * LongPav) / ((LargPav + LargJoint) * (LongPav + LargJoint)), "#.0 %" )
End If
End Function
Function CalcB(LargPav, LongPav, LargJoint)
If LargPav And LongPav And LargJoint <> "" Then
CalcB = Format((((LargPav + LargJoint) * (LongPav + LargJoint)) - (LargPav * LongPav)) / ((LargPav + LargJoint) * (LongPav + LargJoint)), "#.0 %" )
End If
End Function
Function CalcC(LargPav, LongPav, LargJoint, Surf)
If LargPav And LongPav And LargJoint And Surf <> "" Then
CalcC = Format(Surf * ((LargPav * LongPav) / ((LargPav + LargJoint) * (LongPav + LargJoint))), "#.00 m²" )
End If
End Function
Function CalcD(LargPav, LongPav, LargJoint, HautPav, Surf)
If LargPav And LongPav And LargJoint And HautPav <> "" Then
CalcD = Format((HautPav * Surf * ((((LargPav + LargJoint) * (LongPav + LargJoint)) - (LargPav * LongPav)) / ((LargPav + LargJoint) * (LongPav + LargJoint))) / 100), "# ###.00 m3" )
End If
End Function

Merci d'avance pour vos lumières.

@bientôt

Message édité par mmarle le 25-02-2011 à 22:42:39

Publicité

MarieDB1

As-tu des exemples de valeurs qui entraînent le bug ?
La macro va au bout et pas de réponse ou bien s'arrête sur une ligne ? si oui, quel est le message d'erreur et la ligne d'arrêt ?

mmarle

En fait l'application ne plante pas, mais elle ne retourne rien lorsque l'on séléctionne par exemple "8,00" et ses multiples.

Par contre je viens de rectifier le code.

Notamment:
- De supprimer les conditions "if" dans les functions.
- De déclarer les variables à juste titre et non pas mettre variant pour plus de facilité.

Et là tout à l'air de fonctionner à merveille.

mmarle

Bonjour,

Voici le code modifié.

Dans l'Userform:

Code :

Option Explicit
'*****************************'
'* Déclaration des Variables *'
'*****************************'
Dim i As Integer
Dim a As Integer
Dim LargPav As Byte
Dim LongPav As Byte
Dim LargJoint As Single
Dim EpLi As Single
Dim Surf As Single
Dim HautPav As Byte
Dim DosageA As Integer
Dim DosageB As Integer
Private Sub ComboBox1_Click()
'*********************'
'* Largeur des Pavés *'
'*********************'
If ComboBox1 <> "" Then
LargPav = Left(ComboBox1.Value, Len(ComboBox1) - 3)
TextBox2 = CalcA(LargPav, LongPav, LargJoint)
TextBox3 = CalcB(LargPav, LongPav, LargJoint)
TextBox4 = CalcC(LargPav, LongPav, LargJoint, Surf)
TextBox5 = CalcD(LargPav, LongPav, LargJoint, Surf)
TextBox8 = CalcG(LargPav, LongPav, LargJoint, Surf, HautPav)
TextBox9 = CalcH(LargPav, LongPav, LargJoint, Surf, HautPav, DosageB)
Else
LargPav = 0
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox8 = ""
TextBox9 = ""
End If
End Sub
Private Sub ComboBox2_Click()
'**********************'
'* Longueur des Pavés *'
'**********************'
If ComboBox2 <> "" Then
LongPav = Left(ComboBox2.Value, Len(ComboBox2) - 3)
TextBox2 = CalcA(LargPav, LongPav, LargJoint)
TextBox3 = CalcB(LargPav, LongPav, LargJoint)
TextBox4 = CalcC(LargPav, LongPav, LargJoint, Surf)
TextBox5 = CalcD(LargPav, LongPav, LargJoint, Surf)
TextBox8 = CalcG(LargPav, LongPav, LargJoint, Surf, HautPav)
TextBox9 = CalcH(LargPav, LongPav, LargJoint, Surf, HautPav, DosageB)
Else
LongPav = 0
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox8 = ""
TextBox9 = ""
End If
End Sub
Private Sub ComboBox3_Change()
'*********************'
'* Hauteur des Pavés *'
'*********************'
If ComboBox3 <> "" Then
HautPav = Left(ComboBox3.Value, Len(ComboBox3) - 3)
TextBox8 = CalcG(LargPav, LongPav, LargJoint, Surf, HautPav)
TextBox9 = CalcH(LargPav, LongPav, LargJoint, Surf, HautPav, DosageB)
Else
HautPav = 0
TextBox8 = ""
TextBox9 = ""
End If
End Sub
Private Sub ComboBox4_Click()
'**********************'
'* Largeur des Joints *'
'**********************'
If ComboBox4 <> "" Then
LargJoint = Left(ComboBox4.Value, Len(ComboBox4) - 3) / 10
TextBox2 = CalcA(LargPav, LongPav, LargJoint)
TextBox3 = CalcB(LargPav, LongPav, LargJoint)
TextBox4 = CalcC(LargPav, LongPav, LargJoint, Surf)
TextBox5 = CalcD(LargPav, LongPav, LargJoint, Surf)
TextBox8 = CalcG(LargPav, LongPav, LargJoint, Surf, HautPav)
TextBox9 = CalcH(LargPav, LongPav, LargJoint, Surf, HautPav, DosageB)
Else
LargJoint = 0
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox8 = ""
TextBox9 = ""
End If
End Sub
Private Sub ComboBox5_Change()
'*************************'
'* Epaisseur Lit de Pose *'
'*************************'
If ComboBox5 <> "" Then
EpLi = (Left(ComboBox5.Value, Len(ComboBox5) - 3)) / 100
TextBox6 = CalcE(Surf, EpLi)
TextBox7 = CalcF(Surf, EpLi, DosageA)
Else
EpLi = 0
TextBox6 = ""
TextBox7 = ""
End If
End Sub
Private Sub ComboBox6_Change()
'*************************************'
'* Dosage en Ciment pour Lit de Pose *'
'*************************************'
If ComboBox6 <> "" Then
DosageA = Left(ComboBox6.Value, Len(ComboBox6) - 6)
TextBox7 = CalcF(Surf, EpLi, DosageA)
Else
DosageA = 0
TextBox7 = ""
End If
End Sub
Private Sub ComboBox7_Click()
'********************************'
'* Dosage en Ciment pour joints *'
'********************************'
If ComboBox7 <> "" Then
DosageB = Left(ComboBox7.Value, Len(ComboBox7) - 6)
TextBox9 = CalcH(LargPav, LongPav, LargJoint, Surf, HautPav, DosageB)
Else
DosageB = 0
TextBox9 = ""
End If
End Sub
Private Sub CommandButton1_Click()
'*****************'
'* Bouton Fermer *'
'*****************'
'Ferme RatioBox'
Unload RatioBox
End Sub
Private Sub TextBox1_AfterUpdate()
'*************************'
'* Mise en Forme Surface *'
'*************************'
TextBox1 = Format(TextBox1, "# ### ##0.00 m²" )
If TextBox1 <> "" Then
Surf = Left(TextBox1.Value, Len(TextBox1.Value) - 3)
TextBox4 = CalcC(LargPav, LongPav, LargJoint, Surf)
TextBox5 = CalcD(LargPav, LongPav, LargJoint, Surf)
TextBox6 = CalcE(Surf, EpLi)
TextBox7 = CalcF(Surf, EpLi, DosageA)
TextBox8 = CalcG(LargPav, LongPav, LargJoint, Surf, HautPav)
TextBox9 = CalcH(LargPav, LongPav, LargJoint, Surf, HautPav, DosageB)
Else
Surf = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
End If
End Sub
Private Sub TextBox2_Change()
'*****************************'
'* Mise en Forme Ratio Pavés *'
'*****************************'
TextBox2 = Format(TextBox2, "#.00 %" )
Select Case CalcA(LargPav, LongPav, LargJoint)
Case Is = 0
TextBox2 = ""
Case Is = 1
TextBox2 = ""
End Select
End Sub
Private Sub TextBox3_Change()
'******************************'
'* Mise en Forme Ratio Joints *'
'******************************'
TextBox3 = Format(TextBox3, "#.00 %" )
Select Case CalcB(LargPav, LongPav, LargJoint)
Case Is = 0
TextBox3 = ""
Case Is = 1
TextBox3 = ""
End Select
End Sub
Private Sub TextBox4_Change()
'*******************************'
'* Mise en Forme Surface Pavés *'
'*******************************'
TextBox4 = Format(TextBox4, "# ##0.00 m²" )
Select Case CalcC(LargPav, LongPav, LargJoint, Surf)
Case Is = 0
TextBox4 = ""
Case Is = 1
TextBox4 = ""
End Select
End Sub
Private Sub TextBox5_Change()
'********************************'
'* Mise en Forme Surface Joints *'
'********************************'
TextBox5 = Format(TextBox5, "# ##0.00 m²" )
Select Case CalcD(LargPav, LongPav, LargJoint, Surf)
Case Is = 0
TextBox5 = ""
Case Is = 1
TextBox5 = ""
End Select
End Sub
Private Sub TextBox6_Change()
'************************************'
'* Mise en Forme Volume Lit de Pose *'
'************************************'
TextBox6 = Format(TextBox6, "# ##0.00 m3" )
Select Case CalcE(Surf, EpLi)
Case Is = 0
TextBox6 = ""
Case Is = 1
TextBox6 = ""
End Select
End Sub
Private Sub TextBox7_Change()
'********************************************************'
'* Mise en Forme Nbre de Sac de Ciment pour Lit de Pose *'
'********************************************************'
'TextBox7 = TextBox7
Select Case CalcF(Surf, EpLi, DosageA)
Case Is = 0
TextBox7 = ""
Case Is = 1
TextBox7 = ""
End Select
End Sub
Private Sub TextBox8_Change()
'*******************************'
'* Mise en Forme Surface Pavés *'
'*******************************'
TextBox8 = Format(TextBox8, "# ##0.00 m3" )
Select Case CalcG(LargPav, LongPav, LargJoint, HautPav, Surf)
Case Is = 0
TextBox8 = ""
Case Is = 1
TextBox8 = ""
End Select
End Sub
Private Sub TextBox9_Change()
Select Case CalcH(LargPav, LongPav, LargJoint, HautPav, Surf, DosageB)
Case Is = 0
TextBox9 = ""
Case Is = 1
TextBox9 = ""
End Select
End Sub
Private Sub UserForm_Initialize()
'***************************'
'* Initialisation RatioBox *'
'***************************'
'Initialisation Largeur des Pavés'
With ComboBox1
.AddItem ""
End With
'Initialisation Longueur des Pavés'
With ComboBox2
.AddItem ""
End With
For i = 5 To 100
'Initialisation Largeur des Pavés'
With ComboBox1
.AddItem Format(i, "#.00 cm" )
End With
'Initialisation Longueur des Pavés'
With ComboBox2
.AddItem Format(i, "#.00 cm" )
End With
Next i
'Initialisation Hauteur des Pavés'
With ComboBox3
.AddItem ""
.AddItem Format(6, "#.00 cm" )
.AddItem Format(8, "#.00 cm" )
.AddItem Format(14, "#.00 cm" )
.AddItem Format(20, "#.00 cm" )
End With
'Initialisation Largeur des Joints'
With ComboBox4
.AddItem ""
.AddItem 8 & " mm"
.AddItem 10 & " mm"
.AddItem 15 & " mm"
.AddItem 20 & " mm"
.AddItem 25 & " mm"
.AddItem 30 & " mm"
.AddItem 35 & " mm"
.AddItem 40 & " mm"
End With
'Initialisation Epaisseur Lit de Pose'
With ComboBox5
.AddItem ""
End With
'Initialisation Dosage Ciment'
For i = 3 To 6
With ComboBox5
.AddItem Format(i, " #.00 cm" )
End With
Next i
'Initialisation Dosage Ciment'
With ComboBox6
.AddItem ""
End With
'Initialisation Dosage Ciment'
For a = 100 To 500 Step 25
With ComboBox6
.AddItem a & " Kg/m3"
End With
Next a
'Initialisation Dosage Ciment'
With ComboBox7
.AddItem ""
End With
'Initialisation Dosage Ciment'
For a = 100 To 500 Step 25
With ComboBox7
.AddItem a & " Kg/m3"
End With
Next a
'Saisie dans TextBox désactivée'
TextBox2.Enabled = False
TextBox3.Enabled = False
TextBox4.Enabled = False
TextBox5.Enabled = False
TextBox6.Enabled = False
TextBox7.Enabled = False
TextBox8.Enabled = False
TextBox9.Enabled = False
End Sub

Dans un module:

Code :

Option Explicit
Function CalcA(LargPav, LongPav, LargJoint)
'Calcul du Pourcentage de Pavés'
On Error Resume Next
CalcA = (LargPav * LongPav) / ((LargPav + LargJoint) * (LongPav + LargJoint))
End Function
Function CalcB(LargPav, LongPav, LargJoint)
'Calcul du Pourcentage de Joints'
On Error Resume Next
CalcB = (((LargPav + LargJoint) * (LongPav + LargJoint)) - (LargPav * LongPav)) / ((LargPav + LargJoint) * (LongPav + LargJoint))
End Function
Function CalcC(LargPav, LongPav, LargJoint, Surf)
'Calcul de la surface de Pavés'
On Error Resume Next
CalcC = Surf * ((LargPav * LongPav) / ((LargPav + LargJoint) * (LongPav + LargJoint)))
End Function
Function CalcD(LargPav, LongPav, LargJoint, Surf)
'Calcul de la surface de Joints'
On Error Resume Next
CalcD = Surf * ((((LargPav + LargJoint) * (LongPav + LargJoint)) - (LargPav * LongPav)) / ((LargPav + LargJoint) * (LongPav + LargJoint)))
End Function
Function CalcE(Surf, EpLi)
'Calcul du Volume de Lit de Pose'
On Error Resume Next
CalcE = Surf * EpLi
End Function
Function CalcF(Surf, EpLi, DosageA)
'Calcul du Nombre de Sac de Ciment pour le Lit de Pose'
On Error Resume Next
CalcF = Format(Int((Surf * EpLi * DosageA) / 25), "# ##0" )
End Function
Function CalcG(LargPav, LongPav, LargJoint, Surf, HautPav)
'Calcul du Volume de Joints'
On Error Resume Next
CalcG = (HautPav * Surf * ((((LargPav + LargJoint) * (LongPav + LargJoint)) - (LargPav * LongPav)) / ((LargPav + LargJoint) * (LongPav + LargJoint))) / 100)
End Function
Function CalcH(LargPav, LongPav, LargJoint, Surf, HautPav, DosageB)
'Calcul du Nombre de Sac de Ciment pour les Joints'
On Error Resume Next
CalcH = Format(Int((DosageB * (HautPav * Surf * ((((LargPav + LargJoint) * (LongPav + LargJoint)) - (LargPav * LongPav)) / ((LargPav + LargJoint) * (LongPav + LargJoint))) / 100)) / 25), "# ##0" )
End Function

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[VBA Excel] Problème ComboBox et Function [Résolu]

Sujets relatifs
Problème scrollbar page perso	probleme d'exécution
Problème de connexion malgré les bons identifiants	Probleme verification champ formulaire javascript
A supprimer	Problème d'affiche en PHP
[MAC]Probleme html et swf	[Ada] [Résolu] Problème d'encodage de caractères avec Ada sur Windows
Petit problème php Warning: session_start..	Petit problème php Warning: session_start..
Plus de sujets relatifs à : [VBA Excel] Problème ComboBox et Function [Résolu]

Page générée en 0.120 secondes