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

[gbstyle]

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]

Bonjour.
Non, ce n'est pas la solution, puisque ça ne vérifie pas le diviseur.
Met les Réf sous forme de nombre avec un format "0000".

 

[gbstyle]

pourtant c'est bisare quand j'essaye cela fonctionne et des que je rentre une donnée dans le charges mes labels se calcule
cependant comment est ce que je fait pour vérifier le diviseur ?
moi j'avais pensé dire que si le total des charges et égal à 0 alors on arrête la procédure :/ lol
ok je vais mettre le format nombre

 

[Dranreb]

If Revenus Then Endettement = Charges / Revenus Else Endettement = 1

 

[gbstyle]

je pense qu'il faut la meme chose pour charges car si je crée une fiche et que la valeur revenus n'est pas renseigne il me bloque forcement
après essais il m'emmène sur la meme erreur de ce type :

 

[Dranreb]

Enlève purement et simplement l'instruction qui plante. Le calcul, s'il était possible, est déjà fait dans celle qui précède.
Tu devrais faire de nombreux exercices de programmation sur des sujets très variés pour ne plus être arrêté constamment par de petits détails …

 

[gbstyle]

si tu as des tutos pour travailler sur les sujet je suis preneur lol

 

[gbstyle]

Hey bonjour Dranreb, comment vas tu?
je reviens vers toi car aprés plusieur mois d'utilisation, je ne comprend pas depuis quelque temp je n'arrive pas à résoudre mon problème de suivis facturation sur notre base de données

Option Explicit

'*****************************************************************************************************
'Pose des questions si tu ne comprends pas.
' En gros:
' TableUnique mets, comme son nom l'indique, dans un tableau unique, l'un derrière l'autre, toutes les lignes de facturation préexistantes puis derrière toutes les lignes de commandes, en ajoutant devant une colonne 0 supplémentaire avec 0 pour les factures existantes et 1 pour les lignes de commandes.
' Gigogne réorganise tout ça en le classant, comme demandé à la fin lors de son appel, sur la colonne 1 qui est l'identification de la commande dans les 2 tableaux initiaux. Il renvoie ça dans une collection d'objets de type SsGr. Ceux ci ont une propriété Id qui est la valeur de ce critère de regroupement, donc la réf commande, et une propriété Co qui est à son tour une collection. Chaque membre de cette dernière collection est une table à une dimension de toutes les valeurs d'une ligne de détail. On a donc pour chaque réf commande d'abord l'ancienne ligne de facturation, si elle existait déjà, avec Détail(0) = 0, ensuite un certain nombre de lignes de commandes, toutes avec Détail(0) = 1, mais ça on n'a pas besoin de le tester: si ce n'est pas l'ancienne ligne de facture, c'est forcément une des lignes de commande. Est-ce que tu comprends mieux le processus d'exploration à deux niveaux de l'ensemble ?
' Dans le code joint au poste #382 tu utilise TR(LR, 8) alors qu'il n'est même plus calculé correctement vu que l'instruction qui calculait ce cumul tu l'as mise après, à un endroit complètement idiot, au lieu de la laisser dans la boucle de traitement de toutes les lignes détail des commandes, où elle était la seule à devoir y rester.
'Détail(12) est le montant de la ligne de commande. On doit additionner sur TR(LR, 8) les montants de toutes les lignes de commande associées à la réf. commande, donc celui de chacune d'elles en les parcourant toutes, l'une après l'autre. Mais c'est la seule chose à faire à chaque ligne de commande ! Tes infos des dernière colonnes, il ne faut les mettre qu'une fois, à la fin, pour la ligne de facture en cours d'élaboration, seulement quand on a fini de cumuler en TR(LR, 8) les montants de toutes les lignes de commande, et qu'on y a donc obtenu le montant total. C'est à dire après le End If et le Next Détail, mais avant le Next RefCmd. On ne peut donc plus garder le Next Détail, RefCmd, qui était une contraction de Next Détail suivi de Next RefCmd, parce qu'il y a ces instructions pour les colonnes de fin à mettre entre le Next Détail qui termine la petite boucle interne d'exploration de toutes les lignes de commande attachées au RefCmd et le Next RefCmd qui termine la grande boucle de chaque ligne de factur
'******************************************************************************************************

Private Sub Worksheet_Activate()
Dim Données As Collection, TR(), LR&, RefCmd As SsGr, Détail, PremièreLigne As Boolean
Dim DatTrv As Date
Set Données = Gigogne(TableUnique(Me.ListObjects(1), WshSuivCmd), 1)
'Set Données = Gigogne(TableUnique(Me, WshSuivCmd), 1)
ReDim TR(1 To Données.Count, 1 To 21)
For Each RefCmd In Données
    LR = LR + 1
    TR(LR, 1) = RefCmd.Id ' Identification de la commande
    PremièreLigne = True
    For Each Détail In RefCmd.Co
       If Détail(0) = 0 Then
    Rem. Report des infos manuelles de la ligne de facturation qui existait déjà.  TR(LR, col. fact) = Détail(col. fact)

        TR(LR, 9) = Détail(9)
        TR(LR, 10) = Détail(10)
        TR(LR, 11) = Détail(11)
        TR(LR, 12) = Détail(12)
        TR(LR, 13) = Détail(13)
        TR(LR, 14) = Détail(14)
        DatTrv = TR(LR, 13) + 31
        TR(LR, 15) = DateSerial(Year(DatTrv), Month(DatTrv) + 1, 0)
      
      Else
  
          If PremièreLigne Then
        Rem. Reproduction des informations de la commande.  TR(LR, col. fact) = Détail(col. commande)
            TR(LR, 2) = Détail(2)
            TR(LR, 3) = Détail(3)
            TR(LR, 4) = Détail(4)
            TR(LR, 5) = Détail(5)
            TR(LR, 6) = Détail(6)
            TR(LR, 7) = Détail(7)
          
            PremièreLigne = False: End If
        Rem. Cumul en colonne 8 du montant de cette ligne de commande, que ce soit la première ou non :

            TR(LR, 8) = TR(LR, 8) + Détail(14)
       End If: Next Détail
              
            TR(LR, 16) = TR(LR, 8) + TR(LR, 11)
            TR(LR, 17) = Int(TR(LR, 16) * 20 + 0.5) / 100  'TR(LR, 17) = TR(LR, 16) * 20 / 100 modif pour arrondi
            TR(LR, 18) = TR(LR, 16) + TR(LR, 17)
    
        Next RefCmd
        'End If: Next Détail, RefCmd
With Me.ListObjects("TblSuivisFacturation")
    If LR < .ListRows.Count Then .ListRows(LR + 1).Range _
       .Resize(.ListRows.Count - LR).Delete xlShiftUp
    '.DataBodyRange.Resize(LR).Value = TR'pour recalculer la feuille complète
    .DataBodyRange.Resize(LR, 18).Value = TR 'pour recalculer les 18première colonne
    End With
End Sub

Lorsque je clic sur mon bouton de la worksheet suivi facturation il ne me renseigne plus mes donnée et m'emmène sur une erreur de débogage, je n'arrive pas à la résoudre
erreur sur cette ligne
TR(LR, 17) = Int(TR(LR, 16) * 20 + 0.5) / 100

 

[gbstyle]

Les données provenait de la feuille suivis commande, si tu veux que je te renvois le fichier pas de soucis

 

[Dranreb]

Bonjour.
Vérifier si TR(LR, 16) ne contient pas une valeur d'erreur. Mettre des espions sur les expressions impliquées dans l'instruction.

 

[gbstyle]

Je n'ai pas d'erreur sur les expressions à prioris j'ai bien vérifier mes valeur et a prioris je ne comprend pas pourquoi ca ne fonctionne pas

 

[gbstyle]

ce qui est drole c'est que j'ai gardé une version d'archives d'antécédent et ca fonctionne
par contre sur la version ou j'ai rentré tout mon suivis erreur

 

[gbstyle]

et quand on analyse bien je ne vois pas d'ou peut provenir l'erreur

 

[gbstyle]

je viens de constater un décalage de colonne dans la procédure de TR(LR) je vais essayer de remettre ca à jour et si jamais ca fonctionne pas je te retiens au jus

 

[Dranreb]

J'en étais à avoir constaté que TR(LR, 16) contenait un texte commençant par "noirnoirnoir …
Mais d'où ça venait, ça …

Ah, si: c'est une concaténation des valeurs de N63:N73

 

[gbstyle]

Bonjour Dranreb, comment vas tu.
J'ai 2 petit soucis

1-J'ai une petite mise à jour de procédure avec des check in de la boite à outils à effectuer et je ne comprend pas comment les intégrer dans la procédure

2-Je n'arrive pas à mettre mon format dans une CBX contenant du texte il me met par défaut un numérique +1 :/ alors que je veux par défaut DO2020SL0000, les quatre dernière valeur sont évolutive donc dans l'hypothèse il faut la dernière valeur rentrée

Comme tu peux voir j'ai voulu utiliser notre trame de fond pour un projet perso différent
Procédure bien plus simple en terme de développement

Option Explicit
Private WithEvents CL As ComboBoxLiées, WithEvents CA As ControlsAssociés, TVL(), LCou As Long

Private Sub UserForm_Initialize()
   Set CL = New ComboBoxLiées: CL.Plage WshClients
   Set CA = New ControlsAssociés: Set CA.Colonnes = CL.Colonnes
   CL.Add CBxDossier, "N°Dossier" ', Format:="DO2020SL0000" ', Croissant:=False
   CL.Add CBxApporteur, "Apporteur" ', "&", Croissant:=False
   CA.Add CBxNom, "Nom"
   CA.Add TBxPrénom, "Prénom"
   CA.Add TBxAdract, "Adresse Proposant"
   CA.Add TBxCP, "CP"
   CA.Add TBxVille, "Ville"
   CA.Add TBxTel, "Tél"
   CA.Add TBxEmail, "Email"
   CA.Add CBxNom2, "Nom2"
   CA.Add TBxPrénom2, "Prénom2"
   CA.Add TBxAdract2, "Adresse Proposant2"
   CA.Add TBxCP2, "CP2"
   CA.Add TBxVille2, "Ville2"
   CA.Add TBxTel2, "Tél2"
   CA.Add TBxEmail2, "Email2"
 
   CA.Add TBxPAdr1, "Adr Opé"
   CA.Add TBxPAdr2, "Adr Opé1"
   CA.Add TBxPCP, "CP3"
   CA.Add TBxPpc, "N°PC"
   CA.Add TBxPdelivré, "Date Délivré PC", Format:="mmm.yy"
   CA.Add TBxPDoc, "Date DOC", Format:="mmm.yy"
   CA.Add TBxPDebtravaux, "Date début travaux", Format:="mmm.yy"
   CA.Add TBxPPrevFintravaux, "Date prév fin de trav", Format:="mmm.yy"
   CA.Add TBxTCorp, "Montant trav", Format:="0 000.00 €"
   CA.Add TBxThono, "Montant Hono", Format:="0 000.00 €"
   CA.Add TBxTtot, "Total", Format:="0 000.00 €"
 
 
 
   CA.Add TBxPrecep, "PV récep av réserves levées", Format:="mmm.yy"
   CA.Add TBxPRecapfact, "Récap facture déf", Format:="mmm.yy"
   CA.Add TBxPAttesDo, "Attes DO Définitive", Format:="mmm.yy"
 
   CL.CouleurSympa
   CL.Actualiser
   'If Not Me.ActiveControl Is FrmC Then CL.Stopper

   End Sub
 
 
Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
   Select Case NbrLgn
      Case 1: CBnAjouter.Enabled = False: CBnModifier.Enabled = True: CBnSupprimer.Enabled = True: Exit Sub
      Case 0: CBnAjouter.Enabled = True: CBnModifier.Enabled = False: CBnSupprimer.Enabled = False
      Case Else: CBnAjouter.Enabled = False: CBnModifier.Enabled = False: CBnSupprimer.Enabled = False
      End Select
   ReDim TVL(1 To 1, 1 To CL.Colonnes.Count)
'  TVL(1, 1) = WorksheetFunction.Max(CL.Colonnes("N°Dossier").DataBodyRange) + 1
'   LabRevenus.Caption = "": LabCharges.Caption = "": LabEndettement.Caption = "": LabMensualité.Caption = ""
   CA.ValeursDepuis TVL
   End Sub
 
Private Sub CL_SujFltChg(ByVal CBM As ComboBoxMmbr, ByVal Filtré As Boolean)
'If Not FrmC Is Me.ActiveControl Then Exit Sub
'If Not CBM.CBx Is FrmC.ActiveControl Then Exit Sub
If Not CBM.CBx Is CBxNom Then Exit Sub
If CBM.CBx.MatchFound Or CBM.CBx.Text = "" Then Exit Sub
Dim S ' Sujet temporaire pour recherche intuitive
S = SujCBxLike(CBM.SujetFlt, "*" & CBM.CBx.Text & "*")
If IsEmpty(S) Then Exit Sub
CBM.SujetFlt = S ' Affectation du sujet temporaire.
CBM.CBx.DropDown ' Affichage de la liste
End Sub

Private Sub CL_BingoUn(ByVal Ligne As Long)
   LCou = Ligne
   TVL = CL.Lignes(LCou).Range.Value
'  GarnirLabel
   CA.ValeursDepuis TVL
   End Sub
 
Private Sub CBnEffacer_Click()
   CL.Nettoyer
   End Sub
 
Private Sub CBnAjouter_Click()
   CL.ValeursVers TVL
   CA.ValeursVers TVL
   TVL(1, 1) = WorksheetFunction.Max(CL.Colonnes("N°Dossier").DataBodyRange) + 1
   CL.Lignes.Add.Range.Resize(, 34).Value = TVL
   CL.Actualiser
   End Sub
 
Private Sub CBnModifier_Click()
   CA.ValeursVers TVL
   CL.Lignes(LCou).Range.Resize(, 34).Value = TVL
   End Sub
 
Private Sub CBnSupprimer_Click()
   CL.Lignes(LCou).Delete
   CL.Actualiser
   End Sub