Pb d'adaptation au format

oasis_1

oasis_1

XLDnaute Occasionnel
Bonjour le Forum,

j'utilise une userform pour modifier si il y a besoin un tableau.

le tableau étant trop lourd ci joint les formules vba

Private Sub TextBox4_Change()
TextBox4 = Format(TextBox4.Value, " 0 000.00 " & " €")
End Sub

Private Sub TextBox5_Change()
TextBox5 = Format(TextBox5.Value, " 0 000.00 " & " €")
End Sub

Private Sub TextBox6_Change()
TextBox6 = Format(TextBox6.Value, " 000.00 " & " €")
End Sub

pour que les textbox affiche en €

puis la validation pour enregistrer :

Private Sub Enregistré_Click() 'Bibliothèque
Dim Nb As Integer, Dnb As Integer, i As Integer, Y As String
Dim Element_Select As String
Dnb = Sheets("Semaine").Range("w2").Value
Nb = UserForm18.ListBox1.ListCount
Element_Select = False
Sheets("Semaine").Activate

' TextBox = Format(TextBox.Value, " 0.00 €")
Y = 4 'Sur Feuil2 ligne de départ de la bibli ----> "A3"

'----------- MODIFICATION DES DONNEES EN BIBLI ----------
For i = 0 To Nb - 1
If UserForm18.ListBox1.Selected(i) = True Then
Element_Select = True
Range("b" & i + Y).Value = TextBox2
Range("c" & i + Y).Value = TextBox3
Range("d" & i + Y).Value = TextBox4
Range("e" & i + Y).Value = TextBox5
Range("f" & i + Y).Value = TextBox6
With Range("f" & i + Y)
.HorizontalAlignment = xlHAlignRight
.VerticalAlignment = xlVAlignCenter
With .Font
' .Size = 10
' .Italic = False
'.Bold = False
' .Name = "Arial"
End With
End With
End If
Next
If Element_Select = True Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False

TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
TextBox5 = Clear
TextBox6 = Clear
Next i
End If

'------------- AJOUT DE DONNEES EN BIBLI ----------------
If Element_Select = False Then

Range("b" & Dnb + Y).Value = TextBox2
Range("c" & Dnb + Y).Value = TextBox3
Range("d" & Dnb + Y).Value = TextBox4
Range("e" & Dnb + Y).Value = TextBox5
Range("f" & Dnb + Y).Value = TextBox6
With Range("f" & i + Y)
.HorizontalAlignment = xlHAlignRight
.VerticalAlignment = xlVAlignCenter
End With
Dnb = Dnb + 2
ElseIf TextBox2 = "" Then
Dnb = Dnb - 1
For J = 0 To Nb + 4
If "" = Range("b" & J + Y).Value Then 'supprime ligne vide
Range("b" & J + Y).Select
For X = -1 To 2
Range("b" & J + Y).Offset(0, X) = Range("b" & J + Y).Offset(1, X).Value
Range("b" & J + Y).Offset(1, X).Value = Clear
Next
End If
Next
Else
End If

TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
TextBox5 = Clear
TextBox6 = Clear
Call box1
Dnb = Sheets("Semaine").Range("w2").Value
' UserForm1.Label7.Caption = "Quantité Données Bibliothèque : " & dnb
ActiveWorkbook.Save
Sheets("Semaine").Protect
End Sub

Seulement pas tres pratique et je souhaiterai pouvoir intégrer directement dans Private Sub Enregistré .

pour qu'au final en validant les textbox 4,5 et 6 s'affiche sur ma feuille au bon format

merci par avance
 
Trier par date Trier par votes
J

jp14

XLDnaute Barbatruc
Re : Pb d'adaptation au format

Bonjour

Formater des données pendant la saisie peut parfois poser des problèmes, il ne faut pas oublier que les variables sont de type String dans un textbox.

A tester
Code: 
if isnumeric (TextBox5.value ) then ' on vérifie si la valeur est numérique
Range("e" & i + Y).Value =format( TextBox5.value ,"##,##0.00 €")
end if

JP
 
Dernière édition:
Vote positif 0 Vote négatif
oasis_1

oasis_1

XLDnaute Occasionnel
Re : Pb d'adaptation au format

Bonjour JP14,

Super merci il y avait juste un bug, il manquait les "

if isnumeric (TextBox5.value ) then ' on vérifie si la valeur est numérique
Range("e" & i + Y).Value =format( TextBox5.value ,"##,##0.00 €")
end if

Merci encore pour ton aide
 
Vote positif 0 Vote négatif
oasis_1

oasis_1

XLDnaute Occasionnel
Re : Pb d'adaptation au format

Bonjour le Forum, JP14,

Encore un Problème

En effet les infos rentrées dans mes textbox s'impacte bien dans mon tableau
Par contre les calculs qui suive ne se font pas comme si les cellules était vide or si j'impacte manuellement mes cellules les calculs se font.

Et donc la question comment faire pour que les cellules soit active en impactant avec Private Sub Enregistré .


Merci par avance
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Pb d'adaptation au format

re:

je crois comprendre ton problème ! il s'agit des virgules !
depuis Vb pour coller des valeurs dans les cellules il lui faut au départ un (.)
sinon c'est considéré comme du texte dans excel malgré qu'il y ai cette virgule !
c'est un problème rencontré par beaucoup de débutant(tant que l'on est pas eu ...)

Alors il faut voir partout dans ton code où tu colles des valeurs dans les cellules...
faire comme ceci avec Replace() Exemple là ou il y a ceci :
Range("b" & i + Y).Value = Replace(TextBox2, ",", ".")
Range("c" & i + Y).Value = Replace(TextBox3, ",", ".")
Range("d" & i + Y).Value = TextBox4 idem
Range("e" & i + Y).Value = TextBox5 idem
Range("f" & i + Y).Value = TextBox6 idem
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Pb d'adaptation au format

re:

essai déjà comme ceci

Range("b" & i + Y).Value = Format(TextBox2.Value, "##,##0.00 €")
Range("c" & i + Y).Value = Format(TextBox3.Value, "##,##0.00 €")
Range("d" & i + Y).Value = Format(TextBox4.Value, "##,##0.00 €")
Range("e" & i + Y).Value = Format(TextBox5.Value, "##,##0.00 €")
Range("f" & i + Y).Value = Format(TextBox6.Value, "##,##0.00 €")

Range("b" & Dnb + Y).Value = Format(TextBox2.Value, "##,##0.00 €")
Range("c" & Dnb + Y).Value = Format(TextBox3.Value, "##,##0.00 €")
Range("d" & Dnb + Y).Value = Format(TextBox4.Value, "##,##0.00 €")
Range("e" & Dnb + Y).Value = Format(TextBox5.Value, "##,##0.00 €")
Range("f" & Dnb + Y).Value = Format(TextBox6.Value, "##,##0.00 €")
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Pb d'adaptation au format

re:

essai comme ceci sans mettre de format dans les TextBox?

Code: 
Private Sub TextBox4_Change()
'TextBox4 = Format(TextBox4.Value, "##,##0.00 €")
End Sub
Private Sub TextBox5_Change()
'TextBox5 = Format(TextBox5.Value, "##,##0.00 €")
End Sub
Private Sub TextBox6_Change()
'TextBox6 = Format(TextBox6.Value, "##,##0.00 €")
End Sub
Private Sub Enregistré_Click() 'Bibliothèque
Dim Nb As Integer, Dnb As Integer, i As Integer, Y As String
Dim Element_Select As String
Dnb = Sheets("Semaine").Range("w2").Value
Nb = UserForm18.ListBox1.ListCount
Element_Select = False
Sheets("Semaine").Activate

' TextBox = Format(TextBox.Value, " 0.00 €")
Y = 4 'Sur Feuil2 ligne de départ de la bibli ----> "A3"

'----------- MODIFICATION DES DONNEES EN BIBLI ----------
For i = 0 To Nb - 1
 If UserForm18.ListBox1.Selected(i) = True Then
    Element_Select = True
    Range("b" & i + Y).Value = Replace(TextBox2.Value, ",", ".")
    Range("c" & i + Y).Value = Replace(TextBox3.Value, ",", ".")
    Range("d" & i + Y).Value = Replace(TextBox4.Value, ",", ".")
    Range("e" & i + Y).Value = Replace(TextBox5.Value, ",", ".")
    Range("f" & i + Y).Value = Replace(TextBox6.Value, ",", ".")
    With Range("f" & i + Y)
    .HorizontalAlignment = xlHAlignRight
    .VerticalAlignment = xlVAlignCenter
    '.Font.Size = 10
    '.Font.Italic = False
    '.Font.Bold = False
    '.Font.Name = "Arial"
    End With
 End If
Next

If Element_Select = True Then
   For i = 0 To ListBox1.ListCount - 1
     ListBox1.Selected(i) = False
     TextBox2 = Clear: TextBox3 = Clear: TextBox4 = Clear: TextBox5 = Clear: TextBox6 = Clear
   Next
End If

'------------- AJOUT DE DONNEES EN BIBLI ----------------
If Element_Select = False Then
   Range("b" & Dnb + Y).Value = Replace(TextBox2.Value, ",", ".")
   Range("c" & Dnb + Y).Value = Replace(TextBox3.Value, ",", ".")
   Range("d" & Dnb + Y).Value = Replace(TextBox4.Value, ",", ".")
   Range("e" & Dnb + Y).Value = Replace(TextBox5.Value, ",", ".")
   Range("f" & Dnb + Y).Value = Replace(TextBox6.Value, ",", ".")
   With Range("f" & i + Y)
    .HorizontalAlignment = xlHAlignRight
    .VerticalAlignment = xlVAlignCenter
   End With
   Dnb = Dnb + 2
ElseIf TextBox2 = "" Then 'supprime ligne vide
   Dnb = Dnb - 1
   For J = 0 To Nb + 4
     If Range("b" & J + Y).Value = "" Then
        Range("b" & J + Y).Select
        For X = -1 To 2
         Range("b" & J + Y).Offset(0, X) = Range("b" & J + Y).Offset(1, X).Value
         Range("b" & J + Y).Offset(1, X).Value = Clear
        Next
     End If
   Next
End If
TextBox2 = Clear: TextBox3 = Clear: TextBox4 = Clear: TextBox5 = Clear: TextBox6 = Clear
Call box1
Dnb = Sheets("Semaine").Range("w2").Value
' UserForm1.Label7.Caption = "Quantité Données Bibliothèque : " & dnb
ActiveWorkbook.Save
Sheets("Semaine").Protect
End Sub
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Pb d'adaptation au format

re:

mais est tu certain que ton code est fiable !? (car je ne peux pas le tester!)
pour voir si les boucles s'exécutent bien tu mets un msgbox provisoire dedans pour voir s'il passe bien !

exemple:

'----------- MODIFICATION DES DONNEES EN BIBLI ----------
For i = 0 To Nb - 1
If UserForm18.ListBox1.Selected(i) = True Then
>>> ICI il faudrait mettre Msgbox "je suis dans boucle 1"

puis

'------------- AJOUT DE DONNEES EN BIBLI ----------------
If Element_Select = False Then
Range("b" & Dnb + Y).Value = TextBox2.Value
>>> ICI il faudrait mettre Msgbox "je suis dans boucle 2"


si le message s'affiche c'est qu'il passe ! c'est déjà ça !
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
Microsoft 365 Additionner des cellules même ligne en userform vba
Réponses
13
Affichages
406
sousou
sousou
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
449
Mody200
M
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
229
Francky79
F
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
268
florian50470
F
E
  • Question
XL 2013 vba excel
Réponses
6
Affichages
286
sylvanu
sylvanu
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
B
  • Résolu(e)
Microsoft 365 affecter des valeurs dans un tableau de noms de variable
Réponses
4
Affichages
466
bérylion
B
F
  • Résolu(e)
Microsoft 365 Commentaire cellule dans TextBox dans UserForm
Réponses
4
Affichages
421
Francky79
F
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
184
GClaire
G
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
303
halecs93
halecs93

Membres actuellement en ligne

12 membres et 109 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 492
Messages
2 088 930
Membres
103 984
dernier inscrit
maliko67