Valeur décimale inférieur à 1 non reconnu

Le 27/01/2013 à 18:46

Bonjour à tous

J'ai un faible niveau en vba, mais je me suis quand même lancé dans l'aventure Excel.

J'ai fait un petit formulaire de saisie pour ma facturation dont l'image est en pièce jointe en bas du post.

Les zones de textes, les zones de listes ou les options en blanc, font parties des zones à remplir (Remise, Qté, Code), à sélectionner (ID Client, Prestations, Commerce, Désignation) ou modifiable (Date).

Séquence :

Dès l'ouverture du formulaire, toutes les zones sont initialisées, les zones sont vides. Un numéro est affecté à la facture ainsi que la date du jour.

Après sélection d'un client sur ID Clients, ses données correspondantes sont affichées. Il reste à définir si il s'agit d'une facture à l'origine d'une prestation, d'un commerce ou les deux.

Une remise et/ou un acompte peuvent être saisie dans les zones de sous total située à côté des boutons d'impression, de validation d'enregistrement, etc,....

En partie basse du formulaire après sélection de la désignation d'une référence, un numéro de ligne est attribué ainsi que sa référence et sa valeur monétaire, le tout s'affichant dans les zones respectives.

Il suffit alors de saisir la quantité souhaitée, pour que son montant soit calculé. En cliquant sur le bouton du bas en bout de ligne du formulaire, l'ensemble des données est transmise sur une feuil de calcul Excel.

Pour éviter la transmission d'une ligne ou le montant ne serait pas calculé faute de ne pas avoir saisi la quantité, une condition est ajouté (Private Sub CmdLSuiv_Click()) . Effectivement dans le cas d'un oubli le click sur le bouton de fin de ligne donne lieu à un message ("Vous ne pouvez pas valider une référence sans préciser sa quantité !"). Cela est vrai lorsque la référence possède un prix unitaire, si par contre elle n'en possède pas aucun problème pour valider la ligne.

Mon problème se situe sur la valeur saisie dans la zone Qté (ZtxtQte) lorsqu'elle est inférieures à 1 soit de 0.01 à 0.99

il la considère comme vide. Les valeurs décimales sont reconnues au dessus de 1 mais pas en dessous.

Je ne sais pas comment solutionner ce problème.

Si quelqu'un à une idée je place le code du formulaire juste en dessous.

Pour si retrouver plus facilement je le sépare par commande :

Option Explicit
'format type des msgbox.
Dim Message As String
Dim Titre As String
Dim Style As Byte

Const entrees_decimales_permises = ".,0123456789"
Const entrees_entieres_permises = "0123456789"
Const Point = "."
Const Virgule = ","
Sub annuler()
Dim lLigne As Long

If ZtxtNligne.Value = 1 Then 'Pas de facture
    'Annuler ligne en cours
    ZtxtNligne.Value = 0
    Call NouvelleLigne
    Exit Sub
End If

'Annuler les lignes de la facture annulée
For lLigne = Val(Range("V13").Value) - 1 To 1 Step -1
    If Cells(lLigne, 1).Value <> Val(CboxDesignation.Value) Then
        Exit For 'Terminé
        Else
        With Sheets("Devis_Facture")
        .Range("U2:AA2").Value = ""
        .Range("U4:V4").Value = ""
        .Range("U6:W6").Value = ""
        .Range("Z6").Value = ""
        .Range("U8").Value = ""
        .Range("B19:B46").Value = ""
        .Range("F19:F46").Value = ""
        .Range("N19:N46").Value = ""
        .Range("P19:P46").Value = ""
        .Range("S19:S46").Value = ""
        .Range("W19:W46").Value = ""
        .Range("X19:X46").Value = ""
        .Range("T48").ClearContents
        .Range("P50") = 0
        .Range("V13").Value = 19
        End With
    End If
Next

'Annuler ligne en cours
ZtxtNligne.Value = 0
Call NouvelleLigne

'Annuler entête
CboxIdClient.ListIndex = -1
End Sub
Private Sub UserForm_Initialize()

Call InitialiseFiche
Call InitialiserZone1

'Les boutons de ligne suivante et précédente snt désactivé par défaut
Me.CmdLSuiv.Enabled = False
Me.CmdLPrec.Enabled = False

'Le numéro de ligne du formulaire par défaut est désactivé
Me.ZtxtNligne.Enabled = False
Me.ZtxtNligne.Value = 1

'On affecte les listes aux ComboBox
Me.CboxIdClient.RowSource = ("BD_CLIENTS!ID_Clients")
Me.CboxIdClient.ListIndex = -1
Me.CboxDesignation.RowSource = ("BD_PRESTATIONS!List_Prestations")
Me.CboxDesignation.ListIndex = -1

'On affecte les Boutons Option sur un même Groupe
OptType1.GroupName = "TypeFacture"
OptType2.GroupName = "TypeFacture"
OptType3.GroupName = "TypeFacture"

'On affecte la date du jour sur ZtxtDate au format dd/mm/yyyy
ZtxtDate.Value = Format(Now(), "dd/mm/yyyy")

Call InitialiseTotaux

'on déclare que la facture ou le devis n'a pas été imprimé
Range("AA4").Value = "NON"

'on déclare que la facture ou le devis n'a pas été Validé, Edité (PDF) et Enregistré dans la Base de données
Range("W4").Value = "NON" 'Valider
Range("X4").Value = "NON" 'Enegistrer
Range("Y4").Value = "NON" 'EditerPDF

'on intitule l'objet
If Val(Range("V8")) = 1 Then
    Range("I17").Value = "Facture n°:"
    Range("M52").Value = "Payable avant le :"
    FrmDevisFacture.Caption = ("Edition Facture")
    Me.Label22.Caption = ("N° de facture")
    Me.TypeFacture.Caption = ("Type de facture")
    Call NumFact
    ElseIf Val(Range("V8")) = 2 Then
    Range("I17").Value = "Devis n°:"
    Range("M52").Value = "Offre valable jusqu'au :"
    FrmDevisFacture.Caption = "Edition Devis"
    Me.Label22.Caption = ("N° de devis")
    Me.TypeFacture.Caption = ("Type de devis")
    Call NumDev
    Else
    Exit Sub
End If
Worksheets("Devis_Facture").Activate
End Sub
Private Sub InitialiserZone1()

Dim Ctl As Object
With Me.Zone1
For Each Ctl In Me.Controls
    If TypeOf Ctl Is MSForms.TextBox Then
        Ctl.Value = ""
    ElseIf TypeOf Ctl Is MSForms.ComboBox Then
        Ctl.ListIndex = -1
    End If
Next Ctl
End With
End Sub
Private Sub InitialiseTotaux()

'Initialisation des totaux
Worksheets("Devis_Facture").Select
With Worksheets("Devis_Facture")
    Me.ZtxtSousTot.Text = Range("P47")
    Me.ZtxtTVAR.Text = Range("D49")
    Me.ZtxtTVAN.Text = Range("D50")
    Me.ZtxtMontantDu = Range("P51")
End With
End Sub
Private Sub InitialiserZone2()
If CboxDesignation.ListIndex = -1 Then
    Me.ZtxtPrxUnit.Value = ""
    Me.ZtxtQte.Value = ""
    Me.ZtxtCode.Value = ""
    Me.ZtxtPref.Value = ""
    Me.ZtxtRef.Value = ""
End If
End Sub
Private Sub InitialiseFiche()

'on vide toute les données de la facture par defaut
With Sheets("Devis_Facture")
    .Range("U2:AA2").ClearContents
    .Range("U4:V4").ClearContents
    .Range("U6:W6").ClearContents
    .Range("Z6").ClearContents
    .Range("U8").ClearContents
    .Range("B19:B46").ClearContents
    .Range("F19:F46").Value = ""
    .Range("N19:N46").Value = ""
    .Range("P19:P46").ClearContents
    .Range("S19:S46").ClearContents
    .Range("W19:W46").ClearContents
    .Range("X19:X46").ClearContents
    .Range("T48").ClearContents
    .Range("P50") = 0
    .Range("V13").Value = 19
End With
End Sub
Private Sub CboxIdClient_Change()

Dim Rg As Range
Dim Sh As Worksheet

Set Sh = Worksheets("BD_CLIENTS")

If Me.CboxIdClient.ListIndex > -1 Then
    'Recherche l'ID
    Set Rg = Worksheets("BD_CLIENTS").Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValues, lookat:=xlWhole)
    'Si ID trouvé on alimente les zones du formulaire en données
    If Not Rg Is Nothing Then
        Me.ZtxtFormeJuridique.Text = Rg.Offset(0, 1).Value
        Me.ZtxtRaisonSociale.Text = Rg.Offset(0, 2).Value
        Me.ZtxtCivilite.Text = Rg.Offset(0, 3).Value
        Me.ZtxtFonction.Text = Rg.Offset(0, 4).Value
        Me.ZtxtPrenom.Text = Rg.Offset(0, 6).Value
        Me.ZtxtNom.Text = Rg.Offset(0, 5).Value
        Me.ZtxtAdresseL1.Text = Rg.Offset(0, 7).Value
        Me.ZtxtAdresseL2.Text = Rg.Offset(0, 8).Value
        Me.ZtxtCodePostal.Text = Rg.Offset(0, 9).Value
        Me.ZtxtVille.Text = Rg.Offset(0, 10).Value
        Set Rg = Nothing
    End If
    Else
    InitialiserZone1
End If
End Sub
Private Sub NumDev()

'On affecte le nouveau numéro de facture suivant l'ordre chronologique définit
Worksheets("BD_DEVIS").Select
Dim VarMois As String, ExVarMois As Variant
Dim LastCel As Range
With Worksheets("BD_DEVIS")
    Set LastCel = [B65536].End(xlUp)
    ExVarMois = Split(LastCel, "-DEV")
    VarMois = Format(Date, "yymmdd")
    If ExVarMois(0) = VarMois Then
        Me.ZtxtNumFact.Text = ExVarMois(0) & "-DEV" & Format(CStr(ExVarMois(1) + 1), "00")
    Else
        Me.ZtxtNumFact.Text = VarMois & "-DEV01"
    End If
End With
End Sub
Private Sub NumFact()

'On affecte le nouveau numéro de facture suivant l'ordre chronologique définit
Worksheets("BD_FACTURES").Select
Dim VarMois As String, ExVarMois As Variant
Dim LastCel As Range
With Worksheets("BD_FACTURES")
    Set LastCel = [B65536].End(xlUp)
    ExVarMois = Split(LastCel, "-")
    VarMois = Format(Date, "yymmdd")
    If ExVarMois(0) = VarMois Then
        Me.ZtxtNumFact.Text = ExVarMois(0) & "-" & Format(CStr(ExVarMois(1) + 1), "000")
    Else
        Me.ZtxtNumFact.Text = VarMois & "-001"
    End If
End With
End Sub
Sub NouvelleLigne()

Me.ZtxtNligne.Value = Me.ZtxtNligne.Value + 1
Me.CboxDesignation.ListIndex = -1
Me.ZtxtPrxUnit.Value = ""
Me.ZtxtQte.Value = ""
Me.ZtxtCode.Value = ""
Me.ZtxtPref.Value = ""
Me.ZtxtRef.Value = ""

Call InitialiseTotaux
End Sub
Private Sub CboxDesignation_Change()

Dim Rg As Range
Dim Sh As Worksheet

Set Sh = Worksheets("BD_PRESTATIONS")

If (Me.CboxDesignation.ListIndex <> -1 Or (Val(ZtxtNligne.Value) > 1 And Val(ZtxtNligne.Value) <= 28)) And (Me.ZtxtPrxUnit.Value <> 0 Or Me.ZtxtPrxUnit.Value = "") Then
    Me.ZtxtMontant.Enabled = True
    Me.ZtxtNligne.Enabled = True
    Me.CmdLSuiv.Enabled = True
    Me.CmdLPrec.Enabled = True
    'Recherche de la Référence
    Set Rg = Worksheets("BD_PRESTATIONS").Range("A:A").Find(what:=CboxDesignation.Value, LookIn:=xlValues, lookat:=xlWhole)
    'Si Référence trouvée on alimente les zones du formulaire en données
    If Not Rg Is Nothing Then
        Me.ZtxtPref.Text = Rg.Offset(0, 1).Value
        Me.ZtxtRef.Text = Rg.Offset(0, 2).Value
        Me.ZtxtPrxUnit.Text = Rg.Offset(0, 6).Value
        Set Rg = Nothing
    End If
    Else
    Me.ZtxtNligne.Enabled = False
    Me.CmdLSuiv.Enabled = False
    Me.CmdLPrec.Enabled = False
    InitialiserZone2
End If
End Sub
Private Sub CmdLSuiv_Click()

Dim obj1 As String, obj2 As String, term As String, BaseD As String
If Val(Range("V8")) = 1 Then
    obj1 = "la facture :"
    obj2 = "facture"
    term = "e"
    BaseD = "BD_FACTURES"
    ElseIf Val(Range("V8")) = 2 Then
    obj1 = "le devis :"
    obj2 = "devis"
    term = ""
    BaseD = "BD_DEVIS"
    Else
    Exit Sub
End If

Dim i, N, j
For i = 1 To 3
    N = N + Controls("OptType" & i).Value
Next i

'Traiter la ligne en cours
If Val(Me.ZtxtPrxUnit.Value) <> Empty And Val(Me.ZtxtQte.Value) = Empty Then 'Pour ne pas enregistrer une ligne nulle
    Beep
    MsgBox "Vous ne pouvez pas valider une référence sans préciser sa quantité !", vbExclamation, "Action impossible !"
    Exit Sub

    ElseIf Val(Me.ZtxtCode.Value) = 0 And Val(Me.ZtxtMontant.Value) <> 0 Then
    MsgBox "Vous ne pouvez pas enregistrer une référence sans préciser son code !", vbExclamation, "Action impossible !"
    Exit Sub

    ElseIf Val(Me.CboxDesignation.ListIndex) = -1 Then
    MsgBox "Vous devez sélectionner une référence pour pouvoir éditer une nouvelle ligne !", vbExclamation, "Action impossible !"
    Exit Sub

    'On teste les saisies...
    ElseIf Me.CboxIdClient.Text = Empty Then
        MsgBox "Vous devez impérativement entrer ou sélectionner un ID CLIENT !", vbExclamation, "Erreur de sélection !"
        CboxIdClient.SetFocus
    Exit Sub

    'On teste les options
    ElseIf N = 0 Then
        MsgBox "Vous devez impérativement sélectionner un type de " & obj2 & " !", vbExclamation, "Sélection obligatoire !"
    Exit Sub

    ElseIf Me.CboxDesignation.Text = Empty And Me.ZtxtNligne < 2 Then
        MsgBox "Vous devez impérativement sélectionner une référence pour éditer " & obj1 & " !", vbExclamation, "Sélection Manquante !"
        CboxDesignation.SetFocus
    Exit Sub

    ElseIf Val(Me.ZtxtRemise.Value) < 0 And Val(Me.ZtxtRemise.Value) > 100 Then
    MsgBox "Vous devez saisir une valeur comprise entre 0 et 100", vbInformation, "Information"
    Exit Sub

    Else 'enregistrer la ligne
        Cells(Range("V13").Value, 2) = Me.ZtxtNligne.Value
        Cells(Range("V13").Value, 6) = Me.CboxDesignation.Value
        Cells(Range("V13").Value, 14) = Me.ZtxtPrxUnit.Value
        Cells(Range("V13").Value, 16) = Me.ZtxtQte.Value
        Cells(Range("V13").Value, 19) = Me.ZtxtCode.Value
        Cells(Range("V13").Value, 23) = Me.ZtxtPref.Value
        Cells(Range("V13").Value, 24) = Me.ZtxtRef.Value
    End If

    'Passer à la ligne suivante
    If Me.CboxDesignation.ListIndex <> -1 Then
        Range("V13").Value = Range("V13").Value + 1
        Else
        Exit Sub
    End If

    'Info nombre de ligne max atteint
    If Val(ZtxtNligne.Value) = 28 Then
        MsgBox "Vous avez édité le nombre maximum de lignes," & Chr(10) & "pouvant être contenues dans la facture.", vbInformation, "Maximum atteint"
    End If

    'Initialiser les champs
    If Cells(Range("V13").Value, 1) <> "" Then
        'Édition de ligne existante
        Me.ZtxtNligne.Value = Cells(Range("V13").Value, 2)
        Me.CboxDesignation.Value = Cells(Range("V13").Value, 6)
        Me.ZtxtPrxUnit.Value = Cells(Range("V13").Value, 14)
        Me.ZtxtQte.Value = Cells(Range("V13").Value, 16)
        Me.ZtxtCode.Value = Cells(Range("V13").Value, 19)
        Me.ZtxtPref.Value = Cells(Range("V13").Value, 23)
        Me.ZtxtRef.Value = Cells(Range("V13").Value, 24)
        Call InitialiseTotaux
    Else
    Call NouvelleLigne
End If
Me.CboxDesignation.SetFocus 'Activer le 1er champ

'On affecte leur valeur
Dim IdFact As String

For Each j In FrmDevisFacture.TypeFacture.Controls
If j = True Then IdFact = j.Caption
Next j

If Me.ZtxtNligne.Value >= 1 And Me.ZtxtNligne.Value <= 28 And Me.ZtxtNligne.Enabled = True Then
'On envoi les données sur la Facture
With Sheets("Devis_Facture")
    .Range("W6").Value = Me.ZtxtNumFact.Value
    .Range("U2").Value = Me.ZtxtFormeJuridique.Value
    .Range("V2").Value = Me.ZtxtRaisonSociale.Value
    .Range("W2").Value = Me.ZtxtCivilite.Value
    .Range("U8").Value = Me.ZtxtFonction.Value
    .Range("Y2").Value = Me.ZtxtNom.Value
    .Range("X2").Value = Me.ZtxtPrenom.Value
    .Range("Z2").Value = Me.ZtxtAdresseL1.Value
    .Range("AA2").Value = Me.ZtxtAdresseL2.Value
    .Range("U4").Value = Me.ZtxtCodePostal.Value
    .Range("V4").Value = Me.ZtxtVille.Value
    .Range("U6").Value = Me.CboxIdClient.Value
    .Range("Z6").Value = Me.ZtxtDate.Value
    .Range("V6").Value = IdFact
    .Range("P50").Value = Me.ZtxtAcompte.Value
    If Me.ZtxtRemise.Value <> Empty Then
        .Range("T48").Value = Me.ZtxtRemise.Value / 100
        Else
        .Range("T48").Value = Me.ZtxtRemise.Value
    End If
End With
End If
Call InitialiseTotaux
End Sub
Private Sub CmdLPrec_Click()

If ZtxtNligne.Value = 1 Then
    'On ne peut pas reculer avant la ligne 1
    Beep
    MsgBox "Vous êtes sur la première ligne !", vbExclamation, "Action impossible !"
    Exit Sub
    End If
With Sheets("Devis_Facture")
    'On traite la ligne en cours
    If Me.CboxDesignation.ListIndex <> -1 Then 'Enregistrer la ligne s'il y a une désignation
        Cells(Range("V13").Value, 2) = ZtxtNligne.Value
        Cells(Range("V13").Value, 6) = CboxDesignation.Value
        Cells(Range("V13").Value, 14) = ZtxtPrxUnit.Value
        Cells(Range("V13").Value, 16) = ZtxtQte.Value
        Cells(Range("V13").Value, 19) = ZtxtCode.Value
        Cells(Range("V13").Value, 23) = ZtxtPref.Value
        Cells(Range("V13").Value, 24) = ZtxtRef.Value
    End If

    'On passer à la ligne précédente
    Range("V13").Value = Range("V13").Value - 1

    'Édition de ligne existante
    ZtxtNligne.Value = Cells(Range("V13").Value, 2)
    CboxDesignation.Value = Cells(Range("V13").Value, 6)
    ZtxtPrxUnit.Value = Cells(Range("V13").Value, 14)
    ZtxtQte.Value = Cells(Range("V13").Value, 16)
    ZtxtCode.Value = Cells(Range("V13").Value, 19)
    ZtxtPref.Value = Cells(Range("V13").Value, 23)
    ZtxtRef.Value = Cells(Range("V13").Value, 24)

    Call InitialiseTotaux
    CboxDesignation.SetFocus 'Activer le 1er champ
End With
InitialiseTotaux
End Sub
Private Sub CmdValider_Click()
Dim obj1 As String, obj2 As String, term As String, BaseD As String
If Val(Range("V8")) = 1 Then
    obj1 = "la facture"
    obj2 = "facture"
    term = "e"
    BaseD = "BD_FACTURES"
    ElseIf Val(Range("V8")) = 2 Then
    obj1 = "le devis"
    obj2 = "devis"
    term = ""
    BaseD = "BD_DEVIS"
    Else
    Exit Sub
End If

'On teste les saisies...
If Me.CboxIdClient.Text = Empty Then
    MsgBox "Vous devez impérativement entrer ou sélectionner un ID CLIENT !", vbExclamation, "Erreur de sélection !"
    CboxIdClient.SetFocus
    Exit Sub
End If

If Me.CboxDesignation.Text = Empty And ZtxtNligne < 2 Then
    MsgBox "Vous devez impérativement sélectionner une référence pour éditer " & obj1 & " !", vbExclamation, "Sélection Manquante !"
    CboxDesignation.SetFocus
    Exit Sub
End If

'On contrôle si la facture ou le devis à été imprimée avant de valider
If Sheets("Devis_Facture").Range("AA4").Value = "NON" And Sheets("Devis_Facture").Range("Y4").Value = "NON" Then
    If MsgBox("Vous n'avez pas lancé l'impression" & Chr(10) & "souhaitez-vous le faire maintenant ?", vbYesNo, "Information") = vbYes Then
        Call CmdImprimer_Click
        Else
    End If
End If

'On contrôle si la facture ou le devis à été enregistré avant de valider
If Sheets("Devis_Facture").Range("X4").Value = "NON" Then
    If MsgBox("Votre " & obj2 & " n'a pas été enregistré" & term & "." & Chr(10) & "Souhaitez-vous le faire maintenant ?", vbYesNo, "Information") = vbYes Then
        Call CmdEnregistrer_Click
        Else
        Exit Sub
    End If

ElseIf Sheets("Devis_Facture").Range("X4").Value = "OUI" Then
    If MsgBox("Souhaitez-vous apporter des modifications avant de valider ?", vbYesNo, "Attention !") = vbYes Then
        Exit Sub

        Else
        Worksheets(BaseD).Select

        'On contrôle pour savoir si le numéro de facture ou  de devis n'existe pas déjà
        Dim NumDevFact
        NumDevFact = Me.ZtxtNumFact.Value

        Set NumDevFact = Range("B:B").Find(NumDevFact, lookat:=xlWhole)
        If NumDevFact Is Nothing Then
            'On envoi les données sur la Base de Données Factures
            Dim NewCel As Double
            NewCel = Cells(65536, 2).End(xlUp).Rows.Row + 1

            With Range("A" & NewCel & ":Z" & NewCel)
                .Insert Shift:=xlDown
                .Offset(-1).FillDown
                .Offset(-1).SpecialCells(xlCellTypeConstants, 23).ClearContents
            End With

            With Sheets(BaseD)
                .Range("B" & Val(NewCel)).Value = ZtxtNumFact.Value
                .Range("C" & Val(NewCel)).Value = ZtxtFormeJuridique.Value
                .Range("D" & Val(NewCel)).Value = ZtxtRaisonSociale.Value
                .Range("E" & Val(NewCel)).Value = ZtxtCivilite.Value
                .Range("F" & Val(NewCel)).Value = ZtxtFonction.Value
                .Range("G" & Val(NewCel)).Value = ZtxtNom.Value
                .Range("H" & Val(NewCel)).Value = ZtxtPrenom.Value
                .Range("I" & Val(NewCel)).Value = ZtxtAdresseL1.Value
                .Range("J" & Val(NewCel)).Value = ZtxtAdresseL2.Value
                .Range("K" & Val(NewCel)).Value = ZtxtCodePostal.Value
                .Range("L" & Val(NewCel)).Value = ZtxtVille.Value
                .Range("M" & Val(NewCel)).Value = CboxIdClient.Value
                .Range("N" & Val(NewCel)).Value = ZtxtDate.Value
                .Range("P" & Val(NewCel)).Value = Sheets("Devis_Facture").Range("V6")
                .Range("Q" & Val(NewCel)).Value = ZtxtMontantDu.Value
                If Val(ZtxtTVAN.Value) > 0 Then
                    .Range("R" & Val(NewCel)).Value = ZtxtTVAN.Value
                    Else
                    .Range("R" & Val(NewCel)).Value = ""
                End If
                If Val(ZtxtTVAR.Value) > 0 Then
                    .Range("S" & Val(NewCel)).Value = ZtxtTVAR.Value
                    Else
                    .Range("S" & Val(NewCel)).Value = ""
                End If
                If Sheets("Devis_Facture").Range("AA4").Value = "OUI" Or Sheets("Devis_Facture").Range("Y4").Value = "OUI" Then
                    .Range("U" & Val(NewCel)).Value = "OUI"
                    Sheets("Devis_Facture").Range("W4").Value = "OUI"
                    Else
                    .Range("U" & Val(NewCel)).Value = "NON"
                End If
            End With

            Call FormatCellAuto
            Worksheets("Devis_Facture").Activate
            MsgBox "Votre " & obj2 & " n°" & Me.ZtxtNumFact.Value & " a bien enregistré" & term & " dans la base de données", vbInformation, obj2 & " ajouté" & term
            Else
            Worksheets("Devis_Facture").Activate
            MsgBox "Votre " & obj2 & " a déjà été validé" & term & " !", vbExclamation, "Action refusée"
            Exit Sub
        End If
    End If
End If

'Si le devis ou la facture à été enregistré et validé on décharge le formulaire
Worksheets("Devis_Facture").Activate
If Range("X4").Value = "OUI" And Range("W4").Value = "OUI" Then
    Unload FrmDevisFacture
    FrmDevisFacture.Show
    Else
    Exit Sub
End If
End Sub
Private Sub CmdQuitter_Click()

Dim obj1 As String, obj2 As String, term As String, BaseD As String
If Val(Range("V8")) = 1 Then
    obj1 = "la facture"
    obj2 = "facture"
    term = "e"
    BaseD = "BD_FACTURES"
    ElseIf Val(Range("V8")) = 2 Then
    obj1 = "le devis"
    obj2 = "devis"
    term = ""
    BaseD = "BD_DEVIS"
    Else
    Exit Sub
End If

If MsgBox("Vous souhaitez abandonner " & obj1 & " en cours ?", vbYesNo, "Annuler " & obj2) = vbYes Then
    If Range("X4").Value = "NON" And Range("W4").Value = "NON" And Range("AA4").Value = "NON" Then
        Call annuler
        Worksheets("Formulaires").Activate
        Unload FrmDevisFacture
        ElseIf Range("X4").Value = "NON" And Range("W4").Value = "NON" And Range("AA4").Value = "OUI" Then
            If MsgBox("Cette " & obj2 & " à été imprimé" & term & " mais n'est ni validé" & term & ", ni enregistré" & term & " ." & Chr("10") & "Souhaitez-vous effectuer ces opérations maintenant ?", vbYesNo, "Attention !") = vbYes Then
                Call CmdEnregistrer_Click
                Call CmdValider_Click
                Else
                Exit Sub
            End If
        ElseIf Range("X4").Value = "NON" And Range("W4").Value = "OUI" Then
            If MsgBox("Vous avez validé " & obj1 & "," & Chr(13) & "mais n'a pas été enregistré" & term & " !" & Chr(10) & "Souhaitez-vous Enregistrer maintenant ?", vbYesNo, "Attention !") = vbYes Then
                Call CmdEnregistrer_Click
                Else
                Exit Sub
            End If
        ElseIf Range("X4").Value = "OUI" And Range("W4").Value = "NON" Then
            If MsgBox("Vous avez enregistré " & obj1 & "," & Chr(13) & "mais n'a pas été validé" & term & " dans la Base de données !" & Chr(10) & "Souhaitez-vous Valider maintenant ?", vbYesNo, "Attention !") = vbYes Then
                Call CmdValider_Click
                Else
                Exit Sub
            End If
        ElseIf Range("X4").Value = "OUI" And Range("W4").Value = "OUI" And Range("AA4").Value = "NON" Then
            If MsgBox("Vous n'avez pas imprimé " & obj1 & "." & Chr(10) & "Souhaitez-vous l'imprimer maintenant ?", vbYesNo, "Option") = vbYes Then
                Call CmdImprimer_Click
                Else
                Call annuler
                Worksheets("Formulaires").Activate
                Unload FrmDevisFacture
            End If
        ElseIf Range("X4").Value = "OUI" And Range("W4").Value = "OUI" And Range("AA4").Value = "OUI" Then
            Call annuler
            Worksheets("Formulaires").Activate
            Unload FrmDevisFacture
            Else
            Exit Sub
        End If
    Exit Sub
End If
End Sub
Private Sub CmdEnregistrer_Click()

Dim obj1 As String, obj2 As String, term As String, BaseD As String
If Val(Range("V8")) = 1 Then
    obj1 = "la facture :"
    obj2 = "facture"
    term = "e"
    BaseD = "BD_FACTURES"
    ElseIf Val(Range("V8")) = 2 Then
    obj1 = "le devis :"
    obj2 = "devis"
    term = ""
    BaseD = "BD_DEVIS"
    Else
    Exit Sub
End If

If ZtxtMontantDu.Value = 0 Then
    MsgBox "Vous ne pouvez pas enregistrer " & obj1 & " non renseigné" & term & " !", vbExclamation, "Oups !!!"
    Exit Sub
    ElseIf ActiveWorkbook.Saved = False Then
        Sheets("Devis_Facture").Select
        Sheets("Devis_Facture").Copy
        If Val(Range("V8")) = 1 Then
            ActiveWorkbook.SaveAs Filename:="C:\Users\Stéphane\Desktop\Factures\" & Range("Z4").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ElseIf Val(Range("V8")) = 2 Then
            ActiveWorkbook.SaveAs Filename:="C:\Users\Stéphane\Desktop\Devis\" & Range("Z4").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        End If
        If ActiveWorkbook.Saved = True Then
            ActiveWorkbook.Close
            Sheets("Devis_Facture").Range("X4").Value = "OUI"
            MsgBox obj1 & " " & Me.ZtxtNumFact.Value & " a bien enregistré" & term & " dans le répertoire Exercice3", vbInformation, obj2 & " ajouté" & term
            Else
            MsgBox "Une erreur est survenue pendant la sauvegarde !", vbExclamation, "Oups !!!"
            Exit Sub
        End If
    End If
End Sub
Private Sub CmdPDF_Click()

Dim obj1 As String, obj2 As String, term As String, BaseD As String
If Val(Range("V8")) = 1 Then
    obj1 = "la facture :"
    obj2 = "facture"
    term = "e"
    BaseD = "BD_FACTURES"
    ElseIf Val(Range("V8")) = 2 Then
    obj1 = "le devis :"
    obj2 = "devis"
    term = ""
    BaseD = "BD_DEVIS"
    Else
    Exit Sub
End If

If ZtxtMontantDu.Value = 0 Then
    MsgBox "Vous ne pouvez pas enregistrer " & obj1 & " non renseigné" & term & " !", vbExclamation, "Oups !!!"
    Exit Sub
    Else
    If Val(Range("V8")) = 1 Then
        Range("A1:T57").Select
        ActiveSheet.PageSetup.PrintArea = "$A$1:$T$57"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Stéphane\Desktop\Factures\" & Range("Z4").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf Val(Range("V8")) = 2 Then
        Range("A1:T57").Select
        ActiveSheet.PageSetup.PrintArea = "$A$1:$T$57"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Stéphane\Desktop\Devis\" & Range("Z4").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
    Sheets("Devis_Facture").Range("Y4").Value = "OUI"
    MsgBox obj1 & " " & Me.ZtxtNumFact.Value & " sous format PDF a bien enregistré" & term & " dans le répertoire Exercice3", vbInformation, obj2 & " ajouté" & term
    Range("A1").Select
End If
End Sub
Private Sub CmdImprimer_Click()

Sheets("Devis_Facture").Select
If Range("AA4").Value = "NON" Then
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Range("AA4").Value = "OUI"
    ElseIf Sheets("Devis_Facture").PrintOut = True And Range("AA4").Value = "OUI" Then
        If MsgBox("Vous avez déjà lancé une impression. Désirez-vous en lancer une nouvelle ?", vbOKCancel, "Nouvelle impression !") = vbOK Then
        ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
        Else
        Exit Sub
    End If
End If
End Sub
Private Sub CmdEffacer_Click()

If MsgBox("Vous souhaitez Effacer la facture en cours ?", vbOKCancel, "Effacer facture") = vbOK Then
    Call annuler
    Call InitialiserZone1

    'Les boutons de ligne suivante et précédente snt désactivé par défaut
    Me.CmdLSuiv.Enabled = False
    Me.CmdLPrec.Enabled = False

    'Le numéro de ligne du formulaire par défaut est désactivé et sa valeur portée à 1
    Me.ZtxtNligne.Enabled = False
    Me.ZtxtNligne.Value = 1

    'On affecte les listes aux ComboBox
    Me.CboxIdClient.RowSource = ("BD_CLIENTS!ID_Clients")
    Me.CboxIdClient.ListIndex = -1
    Me.CboxDesignation.RowSource = ("BD_PRESTATIONS!List_Prestations")
    Me.CboxDesignation.ListIndex = -1

    'On affecte les Boutons Option sur un même Groupe
    OptType1.GroupName = "TypeFacture"
    OptType2.GroupName = "TypeFacture"
    OptType3.GroupName = "TypeFacture"

    'On affecte la date du jour sur ZtxtDate au format dd/mm/yyyy
    ZtxtDate.Value = Format(Now(), "dd/mm/yyyy")

    'on déclare que la facture ou le devis n'a pas été imprimé
    Range("AA4").Value = "NON"

    'on déclare que la facture ou le devis n'a pas été Validé, Edité (PDF) et Enregistré dans la Base de données
    Range("W4").Value = "NON" 'Valider
    Range("X4").Value = "NON" 'Enegistrer
    Range("Y4").Value = "NON" 'EditerPDF

    'on intitule l'objet
    If Val(Range("V8")) = 1 Then
        Range("I17").Value = "Facture n°:"
        Range("M52").Value = "Payable avant le :"
        FrmDevisFacture.Caption = ("Edition Facture")
        Me.Label22.Caption = ("N° de facture")
        Me.TypeFacture.Caption = ("Type de facture")
        Call NumFact
    ElseIf Val(Range("V8")) = 2 Then
        Range("I17").Value = "Devis n°:"
        Range("M52").Value = "Offre valable jusqu'au :"
        FrmDevisFacture.Caption = "Edition Devis"
        Me.Label22.Caption = ("N° de devis")
        Me.TypeFacture.Caption = ("Type de devis")
        Call NumDev
        Else
        Exit Sub
    End If

    Call InitialiseTotaux
    Else
    Exit Sub
End If
End Sub
Private Sub ZtxtMontant_Change()

ZtxtMontant.Value = Format(ZtxtMontant, "0.00")
End Sub
Private Sub ZtxtMontantDu_Change()

ZtxtMontantDu.Value = Format(ZtxtMontantDu, "0.00")
End Sub
Private Sub ZtxtPrxUnit_Change()

ZtxtPrxUnit.Value = Format(ZtxtPrxUnit, "0.00")
End Sub
Private Sub ZtxtQte_Change()

If ZtxtPrxUnit.Value = Empty Then
    ZtxtMontant.Value = Empty
    Else
    ZtxtMontant.Value = ZtxtPrxUnit.Value * ZtxtQte.Value
End If
End Sub
Private Sub ZtxtQte_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'pour l'utilisation du point du pavé numérique comme virgule

If KeyAscii = Asc(Point) Then
        If InStr(ZtxtQte, Virgule) = 0 Then
            KeyAscii = Asc(Virgule)
        Else
            KeyAscii = 0
        End If
    ElseIf InStr(entrees_decimales_permises, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    ElseIf InStr(ZtxtQte, Virgule) > 0 And KeyAscii = Asc(Virgule) Then
        KeyAscii = 0
End If
    If KeyAscii = 13 Then SendKeys "{TAB}": KeyAscii = 0

End Sub
Private Sub ZtxtSousTot_Change()

ZtxtSousTot.Value = Format(ZtxtSousTot, "0.00")
End Sub
Private Sub ZtxtTVAN_Change()

ZtxtTVAN.Value = Format(ZtxtTVAN, "0.00")
End Sub
Private Sub ZtxtTVAR_Change()

ZtxtTVAR.Value = Format(ZtxtTVAR, "0.00")
End Sub

Merci par avance de votre attention.

formulaire
Le 27/01/2013 à 19:16

Pour ceux qui souhaiterai tester ce formulaire je joins une adresse sur un autre forum, le fichier étant trop volumineux pour être sur celui-ci.

A déziper sur le Bureau et il faut penser à modifier les chemins de sauvegarde dans la CmdEnregistrer et la CmdPDF.

Remplacer Stéphane par votre nom de session windows, pour moi le chemin est C:\Users\Stéphane\Desktop\Factures\

Vous aurez comme cela la possibilité de faire les différents test.

Le 27/01/2013 à 19:35

Bonjour

Modifies ta macro ZtxtQte_Change dans le code de l'userform FrmDevisFacture

Private Sub ZtxtQte_Change()

If ZtxtPrxUnit.Value = Empty Then
    ZtxtMontant.Value = Empty
    Else
    ZtxtMontant.Value = ZtxtPrxUnit.Value * Val(Replace(ZtxtQte.Value, ",", "."))
    'ZtxtMontant.Value = ZtxtPrxUnit.Value * ZtxtQte.Value
End If
End Sub
Le 27/01/2013 à 20:06

Salut et merci de ta réponse.

Le problème ne vient pas de la gestion du point ou de la virgule.

Cette option est abordée dans les déclarations d'option et dans le code

Private Sub ZtxtQte_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'pour l'utilisation du point du pavé numérique comme virgule

If KeyAscii = Asc(Point) Then
        If InStr(ZtxtQte, Virgule) = 0 Then
            KeyAscii = Asc(Virgule)
        Else
            KeyAscii = 0
        End If
    ElseIf InStr(entrees_decimales_permises, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    ElseIf InStr(ZtxtQte, Virgule) > 0 And KeyAscii = Asc(Virgule) Then
        KeyAscii = 0
End If
    If KeyAscii = 13 Then SendKeys "{TAB}": KeyAscii = 0
Exit Sub
End Sub

Pour faire court un internaute sur un autre forum vient de me solutionner le problème. Tu peux remarquer qu'un exit sub à été rajouté sur la fin du code ci-dessus et il a suffit de modifier la condition suivante :

Private Sub ZtxtQte_Change()
  ' Si le PU est vide, ou si la Qt est vide, ou si la Qt n'est pas numérique
  If ZtxtPrxUnit.Value = Empty Or ZtxtQte.Value = Empty Or Not IsNumeric(ZtxtQte.Value) Then
    ' On ne calcul rien et on met le montant à zéro
    ZtxtMontant.Value = Empty
  Else
    ZtxtMontant.Value = ZtxtPrxUnit.Value * ZtxtQte.Value
  End If
End Sub

Merci de t'être penché sur ce problème.

Le 27/01/2013 à 20:53

Bonsoir

C'est un gag ?

Rajouter un Exit Sub avant un End Sub c'est comment dire ..... ajouter de l'eau à de l'eau pour qu'elle soit mouillée : Inutile

Tu n'as pas tout copié ?

Mais juste pour m'informer as tu essayé la solution que je propose

Le 29/01/2013 à 10:37
Banzai64 a écrit :

Bonsoir

C'est un gag ?

Rajouter un Exit Sub avant un End Sub c'est comment dire ..... ajouter de l'eau à de l'eau pour qu'elle soit mouillée : Inutile

Tu n'as pas tout copié ?

Mais juste pour m'informer as tu essayé la solution que je propose

Bonjour,

non ce n'est pas un gag et oui le exit sub est mal placé,

Désolé je n'avais pas vu ta réponse.

Pour l'explication, c'est moi qui l'ai mal recopié.

d'ailleurs je l'ai retirer complètement....

En ce qui concerne ta solution, non je n'ai pas eu le temps de la tester, ça devra attendre dimanche prochain.

Je n'ai pas le loisir de le faire en semaine, mais je te tiens informé.

Au risque de me répéter le problème ne vient pas de la gestion du point ou de la virgule mais de la valeur saisie dans ZtxtQte lorsqu'elle est inférieur à 1 et supérieur ou égale à 0.

Pour info voici les modifs apportées sur :

"Le rajout d'une troisième condition" : Or Not IsNumeric(ZtxtQte.Value)

Private Sub ZtxtQte_Change()
  ' Si le PU est vide, ou si la Qt est vide, ou si la Qt n'est pas numérique
  If ZtxtPrxUnit.Value = Empty Or ZtxtQte.Value = Empty Or Not IsNumeric(ZtxtQte.Value) Then
    ' On ne calcul rien et on met le montant à zéro
    ZtxtMontant.Value = Empty
  Else
    ZtxtMontant.Value = ZtxtPrxUnit.Value * ZtxtQte.Value
  End If
End Sub

Suppression de Exit Sub :

Private Sub ZtxtQte_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'pour l'utilisation du point du pavé numérique comme virgule

If KeyAscii = Asc(Point) Then
        If InStr(ZtxtQte, Virgule) = 0 Then
            KeyAscii = Asc(Virgule)
        Else
            KeyAscii = 0
        End If
    ElseIf InStr(entrees_decimales_permises, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    ElseIf InStr(ZtxtQte, Virgule) > 0 And KeyAscii = Asc(Virgule) Then
        KeyAscii = 0
End If
    If KeyAscii = 13 Then SendKeys "{TAB}": KeyAscii = 0
End Sub

et enfin on ré-enfonce le clou avec And Not IsNumeric(Me.ZtxtQte.Value)

dans la première vérif:

Private Sub CmdLSuiv_Click()

Dim obj1 As String, obj2 As String, term As String, BaseD As String
If Val(Range("V8")) = 1 Then
    obj1 = "la facture :"
    obj2 = "facture"
    term = "e"
    BaseD = "BD_FACTURES"
    ElseIf Val(Range("V8")) = 2 Then
    obj1 = "le devis :"
    obj2 = "devis"
    term = ""
    BaseD = "BD_DEVIS"
    Else
    Exit Sub
End If

Dim i, N, j
For i = 1 To 3
    N = N + Controls("OptType" & i).Value
Next i

'Traiter la ligne en cours
If Val(Me.ZtxtPrxUnit.Value) <> Empty And Not IsNumeric(Me.ZtxtQte.Value) Then 'Pour ne pas enregistrer une ligne nulle
    Beep
    MsgBox "Vous ne pouvez pas valider une référence sans préciser sa quantité !", vbExclamation, "Action impossible !"
    Exit Sub

etc......

La gestion du point et de la virgule est déclarée dans les Option Explicit:

Option Explicit
'format type des msgbox.
Dim Message As String
Dim Titre As String
Dim Style As Byte

Const entrees_decimales_permises = ".,0123456789"
Const entrees_entieres_permises = "0123456789"
Const Point = "."
Const Virgule = ","

Ainsi déclaré avec le Private Sub ZtxtQte_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

Quelque soit l'uitlisation du point ou de sa virgule sur le clavier aplha ou du point surle pavé numérique, le formulaire affiche toujours une virgule et effectue le calcul correctement du côté feuil de calcul excel.

Ce code correspond vraiment à mes attentes pour la conception de factures et de devis.

Merci encore.

Rechercher des sujets similaires à "valeur decimale inferieur reconnu"