VBA - Conflit variable variant/monétaire/virgules
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
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
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
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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"
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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...
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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