Enregistrer le format d'une valeur textbox en monétaire

gbstyle · 9 Février 2018

Bonjour, voila je souhaiterai lors de l'enregistrement sur mon tableau que le format nombre soit monétaire
ci joint mon bout de code
Private Sub BtnAenregistrer_Click()
Ref = Me.TxtARefArticles
With Sheets("Base_Articles")
Set trouvé = .Range("TblBaseArticles").Columns(1).Find(Ref, lookat:=xlWhole, LookIn:=xlValues)
If trouvé Is Nothing Then 'il s'agit d'un nouvelle articles
derlig = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'on se positionne sur la dernière ligne
Else 'existe déjà
derlig = trouvé.Row
If MsgBox("Souhaitez vous modifier l'article ?", vbYesNo) = vbNo Then Exit Sub
End If

.Range("A" & derlig) = TxtARefArticles
.Range("B" & derlig) = CboAFamille
.Range("C" & derlig) = CboASousfamille
.Range("D" & derlig) = TxtADesignation
.Range("E" & derlig) = CboAFournisseur
.Range("F" & derlig) = TxtALongueurcolisage
.Range("G" & derlig) = TxtALargeurcolisage
.Range("H" & derlig) = TxtAHauteurcolisage
.Range("I" & derlig) = TxtACréele
.Range("J" & derlig) = TxtANotes
.Range("K" & derlig) = TxtADelaislivraison
.Range("L" & derlig) = TxtAFraistransport
.Range("M" & derlig) = TxtAFacturation
.Range("N" & derlig) = CboAModedegestion
.Range("O" & derlig) = TxtAminicommande
.Range("P" & derlig) = TxtAPrixUnitHT ' => données à afficher en format Euros lors de la saisie dans le text box et lors de l'enregistrement que sont format se mette en monétaire dans le tableau source
J'ai essaye un code avec .NumberFormat = "#,##0.00 $" mais je n'y arrive pas, il me manque une déclaration de variable je pense

End With

End Sub

D'avance merci

Dranreb · 13 Avril 2018

Je ne l'ai pas gardé parce que je ne veux garder qu'un CBxLiéesGbstyle.xlsm et que celui que tu joins n'est jamais complet avec ce qu'on avait fait.

gbstyle · 13 Avril 2018

Je t'envois la version global du projet de suite pas meme non car j'enregistre plusieur version à chaque étape au cas ou en cas de fausse manip de ma part je me rappel l'évolution

Dranreb · 13 Avril 2018

La ref commande est effacée par la Sub GarnirEntrée parce que la ligne entrée/sortie n'existe pas pour le CLsE. Pourquoi n'est elle pas aussi gérée par celui-ci ?

gbstyle · 13 Avril 2018

je ne comprend pas
en gros je dois déclarer la réf commande en tant que cbx lié dans le clse

Dranreb · 13 Avril 2018

Juste la réf article et la désignation me paraissent bien insuffisants pour identifier une ligne de suivi E/S.
il faudrait au moins la commande aussi (quitte à ce qu'elle reste vide pour les sorties), l'emplacement, et même la date.

gbstyle · 13 Avril 2018

Donc oui je rajoute donc mes lignes dans mes CBxlié du Clse

gbstyle · 13 Avril 2018

ci joint code modifié si j'ai bien compris :

VB:

Set CLsE = New ComboBoxLiées
CLsE.Plage [TblSuivisEntreeSortis]
CLsE.Add Me.CBxCRéfArticle, 1, Croissant:=False
CLsE.Add Me.CBxCDesArticle, 2
CLsE.Add Me.CBxCRechecheRéfcommande, 4
CLsE.Add Me.CBxEDate, 6
CLsE.Add Me.CBxEemplacement, 9
CLsE.CouleurSympa
CLsE.Actualiser
If Not Me.ActiveControl Is FrmE Then CLsE.Stopper

End Sub

Private Sub CLsC_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
If NbrLgn = 1 Then Exit Sub
If NbrLgn = 0 Then
LCouC = 0
ReDim TVLC(1 To 1, 1 To 14)
  
GarnirCommande
End If
End Sub

Private Sub CLsC_Résultat(Lignes() As Long)
Dim TDon(), TLBx(), Ldon As Long, LLBx As Long, C As Long
If UBound(Lignes) = 1 Then
   LCouC = Lignes(1)
   TVLC = CLsC.Lignes(LCouC).Range.Value
   GarnirCommande
Else
   TLC = Lignes
   TDon = CLsC.PlgTablo.Value
   ReDim TLBx(1 To UBound(TLC), 1 To 14)
   For LLBx = 1 To UBound(TLC)
      Ldon = TLC(LLBx)
      'For C = 1 To 14: TLBx(LLBx, C) = TDon(Ldon, C): Next C, LLBx ' code pour affichage total listbox changer paramètre 1To8 nb colonne affiché dans la list box
      For C = 1 To 3: TLBx(LLBx, C) = TDon(Ldon, Choose(C, 8, 9, 10)): Next C, LLBx  'choix des colonne à ressortir dans la listbox
   LBxC.List = TLBx:
End If
End Sub

Private Sub CLsE_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
If NbrLgn = 1 Then CBnEValider.Caption = "Modifier": Exit Sub
If NbrLgn = 0 Then 'LBxA.Clear
LCouE = 0
ReDim TVLE(1 To 1, 1 To 10)
GarnirEntree
CBnEValider.Caption = "Ajouter"
End If
End Sub
Private Sub CLsE_Résultat(Lignes() As Long)
Dim TDon(), TLBx(), Ldon As Long, LLBx As Long, C As Long
TLE = Lignes
TDon = CLsE.PlgTablo.Value
ReDim TLBx(1 To UBound(TLE), 1 To 10)
'For LLBx = 1 To UBound(TLC)
'   Ldon = TLC(LLBx)
   'For C = 1 To 6: TLBx(LLBx, C) = Tdon(Ldon, C): Next C, LLBx
'   For C = 1 To 6: TLBx(LLBx, C) = TDon(Ldon, Choose(C, 1, 8, 9, 10, 11, 12)): Next C, LLBx  'choix des colonne à ressortir dans la listbox
'LBxC.List = TLBx
TVLE = CLsE.Lignes(Lignes(1)).Range.Value
GarnirEntree ' Tout:=False
End Sub

Private Sub GarnirCommande()

Me.TBxCQte.Text = TVLC(1, 10)
Me.TBxCPUHT.Text = TVLC(1, 11)

End Sub

Private Sub GarnirEntree()
Me.TBxCPUHT.Text = TVLE(1, 3)
Me.TBxType.Text = TVLE(1, 5)
Me.TBxERéfBL.Text = TVLE(1, 7)
Me.TBxEQte.Text = TVLE(1, 8)
Me.TBxERemarque.Text = TVLE(1, 10)

End Sub

Est cela que tu envisageais? attention j'ai fais une compilation vba projet et j'avais des grosse modif suite à le remise en forme du frame

gbstyle · 13 Avril 2018

Résultat satisfaisant, j'avance petit à petit, j'ai toujour mon problème de Puht qui s'efface mais ca devrait se résoudre
Par contre Après quelque recherche je n'arrive plus à remettre la main sur la procédure qu'on avait établis pour que quand je modifie un combobox lié je n'efface pas mes donner du meme frame .

Dranreb · 13 Avril 2018

Il faut pour cela que la modification n'entraîne aucune recherche, et pour cela il faut que le CLs soit stoppé.

gbstyle · 16 Avril 2018

Bonjour dranreb, après une bonne relecture je n'ai pas réussis à voir ou est le problème
est ce que je dois créer une Private Sub CLsE_SujFltChg(ByVal CBM As ComboBoxMmbr, ByVal Filtré As Boolean) ?

VB:

ption Explicit
Private WithEvents CLsC As ComboBoxLiées, LCouC As Long, TVLC(), TLC() As Long, _
        WithEvents CLsE As ComboBoxLiées, LCouE As Long, TVLE(), TLE() As Long

Private Sub UserForm_Initialize()
Set CLsC = New ComboBoxLiées
CLsC.Plage [TblSuiviscommande]
CLsC.Add Me.CBxCRechecheRéfcommande, 1, Croissant:=False
CLsC.Add Me.CBxCRéfArticle, 8
CLsC.Add Me.CBxCDesArticle, 9
CLsC.CouleurSympa
CLsC.Actualiser
If Not Me.ActiveControl Is FrmC Then CLsC.Stopper

Set CLsE = New ComboBoxLiées
CLsE.Plage [TblSuivisEntreeSortis]
CLsE.Add Me.CBxCRéfArticle, 1, Croissant:=False
CLsE.Add Me.CBxCDesArticle, 2
CLsE.Add Me.CBxCRechecheRéfcommande, 4
CLsE.Add Me.CBxType, 5
CLsE.Add Me.CBxEDate, 6
CLsE.Add Me.CBxEemplacement, 9
CLsE.CouleurSympa
CLsE.Actualiser
If Not Me.ActiveControl Is FrmE Then CLsE.Stopper

End Sub

Private Sub CLsC_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
If NbrLgn = 1 Then Exit Sub
If NbrLgn = 0 Then
LCouC = 0
ReDim TVLC(1 To 1, 1 To 14)
  
GarnirCommande
End If
End Sub

Private Sub CLsC_Résultat(Lignes() As Long)
Dim TDon(), TLBx(), Ldon As Long, LLBx As Long, C As Long
If UBound(Lignes) = 1 Then
   LCouC = Lignes(1)
   TVLC = CLsC.Lignes(LCouC).Range.Value
   GarnirCommande
Else
   TLC = Lignes
   TDon = CLsC.PlgTablo.Value
   ReDim TLBx(1 To UBound(TLC), 1 To 14)
   For LLBx = 1 To UBound(TLC)
      Ldon = TLC(LLBx)
      'For C = 1 To 14: TLBx(LLBx, C) = TDon(Ldon, C): Next C, LLBx ' code pour affichage total listbox changer paramètre 1To8 nb colonne affiché dans la list box
      For C = 1 To 3: TLBx(LLBx, C) = TDon(Ldon, Choose(C, 8, 9, 10)): Next C, LLBx  'choix des colonne à ressortir dans la listbox
   LBxC.List = TLBx:
End If
End Sub

Private Sub CLsE_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
If NbrLgn = 1 Then CBnEValider.Caption = "Modifier": Exit Sub
If NbrLgn = 0 Then 'LBxA.Clear
LCouE = 0
ReDim TVLE(1 To 1, 1 To 10)
GarnirEntree
CBnEValider.Caption = "Ajouter"
End If
End Sub
Private Sub CLsE_Résultat(Lignes() As Long)
Dim TDon(), TLBx(), Ldon As Long, LLBx As Long, C As Long
TLE = Lignes
TDon = CLsE.PlgTablo.Value
ReDim TLBx(1 To UBound(TLE), 1 To 10)
'For LLBx = 1 To UBound(TLC)
'   Ldon = TLC(LLBx)
   'For C = 1 To 6: TLBx(LLBx, C) = Tdon(Ldon, C): Next C, LLBx
'   For C = 1 To 6: TLBx(LLBx, C) = TDon(Ldon, Choose(C, 1, 8, 9, 10, 11, 12)): Next C, LLBx  'choix des colonne à ressortir dans la listbox
'LBxC.List = TLBx
TVLE = CLsE.Lignes(Lignes(1)).Range.Value
GarnirEntree ' Tout:=False
End Sub

Private Sub GarnirCommande()

Me.TBxCQte.Text = TVLC(1, 10)
Me.TBxCPUHT.Text = TVLC(1, 11)

End Sub

Private Sub GarnirEntree()
Me.TBxCPUHT.Text = TVLE(1, 3)
Me.TBxERéfBL.Text = TVLE(1, 7)
Me.TBxEQte.Text = TVLE(1, 8)
Me.TBxERemarque.Text = TVLE(1, 10)

End Sub

Private Sub LBxC_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
LBxC.ListIndex = -1
LCouC = 0
CBnEValider.Caption = "Ajouter"
End Sub


Private Sub FrmE_Enter()
CLsC.Stopper: FrmC.BackColor = &HE9E9FF
CLsE.Réactiver: FrmE.BackColor = &HD8FFD8
End Sub

Private Sub FrmC_Enter()
CLsE.Stopper: FrmE.BackColor = &HE9E9FF
CLsC.Réactiver: FrmC.BackColor = &HD8FFD8
End Sub

Private Sub CBnRazC_Click()
CLsC.Nettoyer
End Sub

Private Sub CBnRazE_Click()
CLsE.Nettoyer
End Sub


'**********************************************
' Procédure permettant de fermer un formulaire
'**********************************************
Private Sub BTnFemer_Click()
   
    Unload Me
End Sub

Private Sub CBnEValider_Click()
'If LCouE = 0 Then ReDim TVLE(1 To 1, 1 To 14)

TVLE(1, 1) = Me.CBxCRéfArticle.Text
TVLE(1, 2) = Me.CBxCDesArticle.Text
TVLE(1, 3) = ValeurTBx(Me.TBxCPUHT, vbCurrency)
TVLE(1, 4) = Me.CBxCRechecheRéfcommande.Text
TVLE(1, 5) = Me.TBxType.Text
TVLE(1, 6) = ValeurTBx(Me.CBxEDate, vbDate)
TVLE(1, 7) = ValeurTBx(Me.TBxERéfBL)
TVLE(1, 8) = ValeurTBx(Me.TBxEQte, vbDouble)
TVLE(1, 9) = ValeurTBx(Me.CBxEemplacement)
TVLE(1, 10) = ValeurTBx(Me.TBxERemarque)


If LCouE = 0 Then
    CLsE.ValeursVers TVLE
    CLsE.Lignes.Add.Range.Resize(, 11).Value = TVLE
    CLsE.Actualiser
    Rem. Refaire un Dictionary ? Refiltrer quelque chose ? On verra !
Else
   
    CLsE.Lignes(LCouE).Range.Resize(, 11).Value = TVLE '11=nombre de colonnes contenant des constantes
   
    End If
End Sub

Dranreb · 16 Avril 2018

Bonjour.
Si vous voulez bénéficier de la recherche intuitive pour la désignation article, pourquoi pas. Mais ça me paraît vraiment secondaire pour l'instant.
Peut être que après le ReDim TVLE(1 To 1, 1 To 10) au lieu de le laisser vide vous pourriez reprendre le prix unitaire de TVLC si LCouC<>0.
Le problème vient de ce que vous ne renseignez pas complètement l'identification de votre ligne de suivi. Donc dès que vous en précisez un nouvel élément, il voit que ça n'existe pas, c'est donc une nouvelle ligne et il efface toute information associée.

gbstyle · 16 Avril 2018

il faut donc que je supprime la cbxlié de la désignation articles ?

Dranreb · 16 Avril 2018

Non. Rien à voir.
C'est l'instruction Me.TBxCPUHT.Text = TVLE(1, 3) de GarnirEntrée qui efface votre prix quand TVLE est à l'image d'une nouvelle ligne, vide. Il faudrait y avoir mis TVLC(1, 11) s'il est renseigné, donc si LCouC<>0

gbstyle · 16 Avril 2018

donc c'est dans la clseChange qu'il faut que je modifie alors ?
il faut que je remplace LcouE = 0 par lcouE <>0

Dranreb · 16 Avril 2018

Effectuez une recherche sur Excel Downloads...

Enregistrer le format d'une valeur textbox en monétaire

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

gbstyle

XLDnaute Impliqué

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums