VBA - Conflit variable variant/monétaire/virgules

120test-rem-cheque.xlsm (813.81 Ko)

Cher contributeurs,

j'ai réussi il y a peu à structurer une super application de remise de chèque automatique.

Je la met en pièce jointe , vous pouvez la réutiliser à loisir.

Si mon code est encore disgracieux à bien des égards, j'ai surtout un gros problème fonctionnel.

Si je crée une remise de chèque manuelle (bouton plume une fois le bordereau ouvert), quelque soit le montant que j'indique (45.20€ ou 45€) la remise de chèque est éditée.

De même si j'utilise la sélection des chèques (cliquez sur les numéros de chèque), la remise de chèque est éditée.

Mais lorsque je fais les deux en même temps, tout fonctionne si les nombres sont entiers (45€, 122€) mais c'est l'apocalypse si il y a un nombre à virgule...

Et vous verrez de plus, souvent la somme totale censée apparaître sur la remise de chèque éditée n'additionne pas, elle accole les strings : 45.0075.00250.00 (surtout quand c'est alimenté par la remise de chèque manuelle).

J'ai l'impression que c'est mon traitement des variables dans la procédure de saisie manuelle (première code ci joint)...

Lorsque je désactive le On Error GoTo ErrorHandler j'obtiens le message d'erreur "Erreur d’exécution 13 (incompatibilité de type)". Ligne concernée: Arr(2, k + 1) = CDec(Arr(2, k + 1)) + CDec(Arr(2, y)) 'Calcul du total par addition des montants de chaque ligne"

J'ai cherché en vain.

Si quelqu'un peut me dire ce qu'il en pense...Je joins le fichier et le code du bouton principale "Editez votre bordereau de remise de chèque" ci-après le premier code (oui je sais, il y a des redim preserve a foison, mais je les aime tant ).

Merci beaucoup.

Private Sub CommandButton1_Click()          '// BOUTON AJOUTER UN CHEQUE MANUELLEMENT//

'Declaration
Dim ArrManu() As Variant

'Interdiction si le montant du chèque est absent
If TextBox3.Value = "" Then
    MsgBox "Veuillez entrer un montant pour ce chèque."

Else

    'Attributions
    ReDim Preserve ArrManu(3, x)
    ArrManu(0, x) = TextBox1
    ArrManu(1, x) = TextBox2
    ArrManu(2, x) = TextBox3

    'Effacer les textbox
    TextBox1.Value = ""
    TextBox2.Value = ""
    TextBox3.Value = ""
    TextBox1.SetFocus

    'Alimentation de la listbox
    With SelecteurBordereau.ListBox1
        .ColumnCount = 3
        .ColumnWidths = "160;150;75"
        .AddItem
        .List(x, 0) = ArrManu(0, x) 'Récupération du nom
        .List(x, 1) = ArrManu(1, x) 'Récupération du numéro de chèque
        .List(x, 2) = ArrManu(2, x) 'Récupération du montant
    'Incrémentation du tableau et de la listbox1
    x = x + 1
    End With
End If
End Sub
Private Sub CommandButton2_Click()           '// BOUTON EDITER VOTRE BORDEREAU DE REMISE DE CHEQUE //

'Déclaration des variables
Dim ws As Worksheet
Dim Cell As Range, rng As Range
Dim Arr() As Variant

Dim i As Byte                       'VARIABLE DE BOUCLES DU LES MOIS
Dim k As Integer                    'VARIABLE DE D'ATTRIBUTION DES DONNEES DU TABLEAU et GUIDANT SON DIMENSIONNEMENT
Dim v As Integer                    'VARIABLE DE BOUCLES SUR LES MOIS
Dim nbrl As Integer                 'VARIABLE DE COMPTAGE DE LIGNE
Dim y As Integer                    'VARIABLE DE BOUCLES SUR LISTBOX PUIS DE SOMME DES MONTANTS DE CHEQUES
Dim w As Integer                    'VARIABLE DECLARANT SI UN MOIS COMPORTE DES CELLULES BLEUES
Dim lRow As Long                    'Lignes des cellules bleues repérées
Dim cellblue As Long                'VARIABLES DE COMPTAGE DES CELLULES BLEUES
Dim alpha As String                 'Renomination des mois à deux chiffres

'Gestion des erreur
On Error GoTo errorhandler

'Effacer bordereau précédent
Sheets("Remise de chèques").Range("H19:K1000").ClearContents

'Vérifier si l'utilisatuer n'a pas sélectionné de cellule et message si aucune cellule sélectionnée
For v = 1 To 12
    alpha = Format(v, "00") 'Dénominations des feuilles passant de la forme "1" à "01"
    Set ws = Worksheets(alpha)
      With ws
                Set rng = .Range("I3:I299")
                For Each Cell In rng
                    If Cell.Interior.COLOR = RGB(174, 240, 194) Then
                    cellblue = cellblue + 1
                    End If
                Next Cell
        End With
Next v

If cellblue < 1 And ListBox1.ListCount = 0 Then  'OU SI SELECTION MANUELLE VIDE
MsgBox "Vous n'avez pas sélectionné de numéro de chèque à éditer dans le bordereau ni entré de chèque manuellement.", 48
Exit Sub
Else

'===========RECUPERATION DES DONNEES CONTENU DANS LES CELLULES EN BLEU SUR CHAQUE FEUILLE MENSUELLE=========================
    'Récupération des données du bordereau
     k = 1
            For i = 1 To 12
            alpha = Format(i, "00") 'Dénominations des feuilles passant de la forme "1" à "01" pour permettre la boucle
            Set ws = Worksheets(alpha)
            With ws
                nbrl = 1
                w = 0
                Set rng = .Range("I3:I299")
                    For Each Cell In rng                                        'Pour chaque cellule dans la colonne des numéro de chèque
                        lRow = Cell.Row
                            If Cell.Interior.COLOR = RGB(174, 240, 194) Then    'Si la cellule est bleu clair
                                ReDim Preserve Arr(4, k + 1)                    'Dimensionner le tableau Arr() à 4 emplacement de colonne, et k+1 emplacements de ligne (nombre de cellule bleu).
                                Arr(0, 0) = "Nom de l'émetteur"
                                Arr(1, 0) = "Numéro de chèque"
                                Arr(2, 0) = "Montant du chèque"
                                Arr(3, 0) = "Exercice mensuel"
                                        Arr(0, k) = .Cells(lRow, 2).Value
                                        Arr(1, k) = .Cells(lRow, 9).Value
                                        Arr(2, k) = .Cells(lRow, 5).Value
                                k = k + 1
                                nbrl = nbrl + 1
                                w = w + 1
                            End If 'Fin de condition "Si une cellule bleu"
                    Next Cell
                If w > 0 Then 'si il y a des cellules bleus dans cette boucle mensuelle écrire le nom de ce mois en haut de la liste
                Arr(3, UBound(Arr, 2) - nbrl + 1) = StrConv(MonthName(i), vbProperCase) 'attribue à la ligne au début de chaque mois
                End If
            End With
        Next i

'========RECUPERATION DES DONNNEES DE LA LISTBOX ISSUES DU USERFORM SAISIE MANUELLE======================================================
        'Récupération des données de la listbox alimentée manuellement
        If ListBox1.ListCount > 0 Then
            For y = 0 To ListBox1.ListCount - 1
                ReDim Preserve Arr(4, k + 1)
                            Arr(0, 0) = "Nom de l'émetteur"
                            Arr(1, 0) = "Numéro de chèque"
                            Arr(2, 0) = "Montant du chèque"
                            Arr(3, 0) = "Exercice mensuel"
                Arr(0, k) = ListBox1.List(y, 0)
                Arr(1, k) = ListBox1.List(y, 1)
                Arr(2, k) = ListBox1.List(y, 2)
                k = k + 1
            Next y
            Arr(3, UBound(Arr, 2) - ListBox1.ListCount) = "Autres"
        Else
        End If

'=======SOMMATION DE L'ENSEMBLE DES DONNEES (MANUELLE ET ISSUES DES CELLULES BLEURS SELECTIONNEES)=======================================
        ReDim Preserve Arr(4, k + 2)
        y = 0
        For y = 1 To k - 1
                Arr(1, k + 1) = "MONTANT TOTAL :"
                Arr(2, k + 1) = Arr(2, k + 1) + Arr(2, y) 'Calcul du total par addition des montants de chaque ligne"
        Debug.Print Arr(0, y) & "    " & Arr(1, y) & "    " & Arr(2, y)
        Next y

        'Restitution dans une nouvelle feuille...
        ActiveWorkbook.Worksheets("Remise de chèques").Activate
        ActiveWorkbook.Worksheets("Remise de chèques").Range("k9") = "Le " & Date & ","
        ActiveWorkbook.Worksheets("Remise de chèques").Cells(18, 8).Resize(UBound(Arr, 2), 4).Value = Application.Transpose(Arr)

        'Ecriture du nombre de cheque
         ActiveWorkbook.Worksheets("Remise de chèques").Cells(17, 8).Value = "Nombre de chèques : " & k - 1

        'Effacement de la listbox
        ListBox1.RowSource = ""
        'Fermeture du userform SelecteurBordereau
        Unload SelecteurBordereau
End If
Exit Sub

errorhandler:
MsgBox "Erreur."
Unload SelecteurBordereau
Exit Sub
End Sub

Bonjour,

Cette anomalie se produit lorsqu'on additionne des valeurs texte, l'opérateur "+" est interprété comme un opérateur de concaténation.

Essayer peut être :

Arr(2, k + 1) = Cdec(Arr(2, k + 1)) + Cdec(Arr(2, y) )

Bonjour Thev,

merci.

Çà bloque toujours: erreur d’exécution 13 (incompatibilité de type).

Ligne concernée:

Arr(2, k + 1) = CDec(Arr(2, k + 1)) + CDec(Arr(2, y)) 'Calcul du total par addition des montants de chaque ligne"

J'ai essayé aussi:

Arr(2, k + 1) = CDec(Arr(2, k + 1) + Arr(2, y)) 'Calcul du total par addition des montants de chaque ligne"

A mon avis, tu as un problème de point décimal au niveau de la saisie du montant.

Si le montant est saisi avec une virgule, il faut rectifier le point décimal avec une instruction de ce type :

ArrManu(2, x) = Val(Replace(TextBox3, ",", "."))

A mon avis, tu as un problème de point décimal au niveau de la saisie du montant.

Si le montant est saisi avec une virgule, il faut rectifier le point décimal avec une instruction de ce type :

ArrManu(2, x) = Val(Replace(TextBox3, ",", "."))

Merci Thev ,

j'ai déjà essayé de forcer l'écriture avec virgule, cependant une fois collé dans la feuille, le mode a beau être "Monétaire", le sigle Euros disparaît (uniquement pour ces nombres issues de mes TextBox) et le menu d'erreur signal "Nombre stocké sous forme de texte"...

Et comble de la situation, l'addition du montant est calculé correctement pour le coup même avec des nombres stockés ainsi.

J'ai essayé de forcer avec Format(Val(Replace(TextBox3, ",", "."))) mais rien y fait.

Mon espoir est intact...

Ceci serait sans doute mieux

Format(Val(Replace(TextBox3, ",", ".")), "#,##0.00")

OUI, pardon j’avais mal écrit, c’est bien ce que j’ai essayé En vain...

Bonjour,

Tu devrais déjà par supprimer ton traitement d'erreur qui n'en est pas un, et qui ne sert qu'à cacher la poussière sous le tapis. Elle fini toujours par ressortir, la preuve.

Si erreur il y a, il faut la traiter en amont pour qu'il n'y en ait pas.

Aucune raison d'accepter par exemple "toto" si tu attends un nombre... Il faut boucler tant que la saisie c'est pas conforme (convertible en nombre) ou abandonnée.

Ensuite c'est au moment de l'affectation qu'il faut convertir :

'Récupération des données de la listbox alimentée manuellement
' ...
Arr(2, k) = Val(Replace(ListBox1.List(y, 2), ",", "."))

Il y aurait bien d'autre chose à dire sur ton code.

Par exemple, dans la boucle que je te fait modifier, je ne suis pas persuadé que ce soit nécessaire de remettre l'en-tête à chaque tour vu qu'il n'est présent qu'une fois au final.

Ailleurs tu boucles pour récupérer les cellules bleues alors que tu as la sélection dans Worksheet_SelectionChange qu'il suffit de mémoriser.

eric

Bonjour,

Pour connaitre le séparateur décimal tu peux utiliser ceci :

Dim Sep As String
Sep = Format(0, ".")

Pour n'autoriser que les chiffres et un seul séparateur, tu peux utiliser ceci :

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii

        Case 44, 46
            KeyAscii = Asc(Format(0, ".")) 'saisi le bon séparateur
            If InStr(TextBox3.Text, Format(0, ".")) <> 0 Then KeyAscii = 0 'supprime si second séparateur

        Case 48 To 57 'ne rien faire (seulement les chiffres)

        Case Else
            KeyAscii = 0 'tout autre caractère est supprimé

    End Select

End Sub

Bonjour,

Tu devrais déjà par supprimer ton traitement d'erreur qui n'en est pas un, et qui ne sert qu'à cacher la poussière sous le tapis. Elle fini toujours par ressortir, la preuve.

Si erreur il y a, il faut la traiter en amont pour qu'il n'y en ait pas.

Aucune raison d'accepter par exemple "toto" si tu attends un nombre... Il faut boucler tant que la saisie c'est pas conforme (convertible en nombre) ou abandonnée.

Ensuite c'est au moment de l'affectation qu'il faut convertir :

'Récupération des données de la listbox alimentée manuellement
' ...
Arr(2, k) = Val(Replace(ListBox1.List(y, 2), ",", "."))

Il y aurait bien d'autre chose à dire sur ton code.

Par exemple, dans la boucle que je te fait modifier, je ne suis pas persuadé que ce soit nécessaire de remettre l'en-tête à chaque tour vu qu'il n'est présent qu'une fois au final.

Ailleurs tu boucles pour récupérer les cellules bleues alors que tu as la sélection dans Worksheet_SelectionChange qu'il suffit de mémoriser.

eric

Merci Theze.

Force est de constater qu'effectivement mon code relève encore du bricolage.

Tes conseils ont porté leur fruits: cela fonctionne.

Merci à vous deux.

Sujet résolu

Bonjour,

je m'autorise à prendre 1/3 du merci

eric

Rechercher des sujets similaires à "vba conflit variable variant monetaire virgules"