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

gbstyle · 14 Avril 2020

Je n'arrive pas à comprendre pourquoi je n'arrive pas a créer d'autre identité :/ il me remplace systématiquement l'existente :/

Dranreb · 14 Avril 2020

Normalement LCou doit être = 0 pour qu'on puisse ajouter, et dans ce cas on fait CL.Lignes.Add.Range.Value = TVL qui ne peut en aucun cas modifier une ligne existante.
Pour la Réf on devrait pouvoir faire auparavant TVL(1, 1) = WorkseetFunction.Max(CL.Colonnes("Réf").DataBodyRange) + 1
ou bien TVL(1, 1) = WorkseetFunction.Max(CL.PlgTablo.Columns(1)) + 1

gbstyle · 14 Avril 2020

Ca me parait bon je ne vois pas ou est l'erreur regarde dans le code si tu vois quelque chose par hasard car moi je trouve pas :/

VB:

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 CBxRefClient, "Réf"
   CL.Add CBxNom, "Nom", "&", Croissant:=False
   CA.Add TBxNomjf, "Nom Jeune Fille"
   CA.Add TBxPrénom, "Prénom"
   CA.Add TBxDatenaiss, "Date Naissance"
   CA.Add TBxLieunaiss, "Lieu Naissance"
   CA.Add TBxDeptnaiss, "Dept Naissance"
   CA.Add CBxSitufam, "Situ Famille"
   CA.Add CBxContrat, "Contrat Mariage"
   CA.Add TBxDatecontrat, "Date Contrat"
   CA.Add TBxEnfants, "Enfants"
   CA.Add TBxAdract, "Adresse Act"
   CA.Add TBxCP, "CP Act"
   CA.Add TBxVille, "Ville Act"
   CA.Add CBxRP, "Résidence Principale"
   CA.Add TBxLoyer, "Loyer", Format:="0 000.00 €"
   CA.Add TBxLoyerdepuis, "Date loyer"
   CA.Add TBxTel, "Telephone", Format:="00 00 00 00 00"
   CA.Add TBxEmail, "Email"
   CA.Add TBxProfession, "Profession"
   CA.Add TBxEmployeur, "Employeur"
   CA.Add CBxTypecont, "Type Contrat"
   CA.Add CBxStatut, "Statut"
   CA.Add TBxAnciennete, "Ancienneté"
   CA.Add TBxPays, "Pays"
   CA.Add TBxNationalite, "Nationalité"

   CA.Add CBxIBBanque, "Banque"
   CA.Add TBxIBAgen, "Agence"
   CA.Add TBxIBAdr, "Adr Agence"
   CA.Add TBxIBCP, "CP Agence"
   CA.Add TBxIBVille, "Ville Agence"
   CA.Add TBxIBNom, "Nom Conseiller"

   CA.Add TBxRSalaire, "Salaire", Format:="0 000.00 €", Mode:="CalcLab"  '= Format(("Salaire"), "0.00 €")  '(Format("Echéance Mensuel1", "0,00€"))
   CA.Add TBxRAlloc, "Allocation", Format:="0 000.00 €"
   CA.Add TBxRRFoncier, "Revenus Foncier", Format:="0 000.00 €"
   CA.Add TBxRPensions, "Pensions", Format:="0 000.00 €"
   CA.Add TBxRRFRN1, "RFR N-1", Format:="0 000.00 €"
   CA.Add TBxRRFRN2, "RFR N-2", Format:="0 000.00 €"
   CA.Add TBxRIRPP, "IRPP", Format:="0 000.00 €"

   CL.Add CBxNom2, "Nom2"
   CA.Add TBxNomjf2, "Nom Jeune Fille2"
   CA.Add TBxPrénom2, "Prénom2"
   CA.Add TBxDatenaiss2, "Date Naissance2"
   CA.Add TBxLieunaiss2, "Lieu Naissance2"
   CA.Add TBxDeptnaiss2, "Dept Naissance2"
   CA.Add CBxSitufam2, "Situ Famille2"
   CA.Add CBxContrat2, "Contrat Mariage2"
   CA.Add TBxDatecontrat2, "Date Contrat2"
   CA.Add TBxEnfants2, "Enfants2"
   CA.Add TBxAdract2, "Adresse Act2"
   CA.Add TBxCP2, "CP Act2"
   CA.Add TBxVille2, "Ville Act2"
   CA.Add CBxRP2, "Résidence Principale2"
   CA.Add TBxLoyer2, "Loyer2", Format:="0 000.00 €"
   CA.Add TBxLoyerdepuis2, "Date loyer2"
   CA.Add TBxTel2, "Telephone2", Format:="00 00 00 00 00"
   CA.Add TBxEmail2, "email2"
   CA.Add TBxProfession2, "Profession2"
   CA.Add TBxEmployeur2, "Employeur2"
   CA.Add CBxTypecont2, "Type Contrat2"
   CA.Add CBxStatut2, "Statut2"
   CA.Add TBxAnciennete2, "Ancienneté2"
   CA.Add TBxPays2, "Pays2"
   CA.Add TBxNationalite2, "Nationalité2"

   CA.Add CBxIBBanque2, "Banque2"
   CA.Add TBxIBAgen2, "Agence2"
   CA.Add TBxIBAdr2, "Adr Agence2"
   CA.Add TBxIBCP2, "CP Agence2"
   CA.Add TBxIBVille2, "Ville Agence2"
   CA.Add TBxIBNom2, "Nom Conseiller2"

   CA.Add TBxRSalaire2, "Salaire2", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxRAlloc2, "Allocation2", Format:="0 000.00 €"
   CA.Add TBxRRFoncier2, "Revenus Foncier2", Format:="0 000.00 €"
   CA.Add TBxRPensions2, "Pensions2", Format:="0 000.00 €"
   CA.Add TBxRRFRN12, "RFR N-12", Format:="0 000.00 €"
   CA.Add TBxRRFRN22, "RFR N-22", Format:="0 000.00 €"
   CA.Add TBxRIRPP2, "IRPP2", Format:="0 000.00 €"

   CA.Add TBxCNom1, "Nom Prêteur1"
   CA.Add CBxCNat1, "Nature du Prêt1"
   CA.Add TBxCDatreal1, "Date de Réalisation1", Format:="mmm.yy"
   CA.Add TBxCDatfin1, "Date de fin1", Format:="mmm.yy"
   CA.Add TBxCRest1, "CRD1", Format:="0 000.00 €"
   CA.Add TBxCEch1, "Echéance Mensuel1", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom2, "Nom Prêteur2"
   CA.Add CBxCNat2, "Nature du Prêt2"
   CA.Add TBxCDatreal2, "Date de Réalisation2", Format:="mmm.yy"
   CA.Add TBxCDatfin2, "Date de fin2", Format:="mmm.yy"
   CA.Add TBxCRest2, "CRD2", Format:="0 000.00 €"
   CA.Add TBxCEch2, "Echéance Mensuel2", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom3, "Nom Prêteur3"
   CA.Add CBxCNat3, "Nature du Prêt3"
   CA.Add TBxCDatreal3, "Date de Réalisation3", Format:="mmm.yy"
   CA.Add TBxCDatfin3, "Date de fin3", Format:="mmm.yy"
   CA.Add TBxCRest3, "CRD3", Format:="0 000.00 €"
   CA.Add TBxCEch3, "Echéance Mensuel3", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom4, "Nom Prêteur4"
   CA.Add CBxCNat4, "Nature du Prêt4"
   CA.Add TBxCDatreal4, "Date de Réalisation4", Format:="mmm.yy"
   CA.Add TBxCDatfin4, "Date de fin4", Format:="mmm.yy"
   CA.Add TBxCRest4, "CRD4", Format:="0 000.00 €"
   CA.Add TBxCEch4, "Echéance Mensuel4", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom5, "Nom Prêteur5"
   CA.Add CBxCNat5, "Nature du Prêt5"
   CA.Add TBxCDatreal5, "Date de Réalisation5", Format:="mmm.yy"
   CA.Add TBxCDatfin5, "Date de fin5", Format:="mmm.yy"
   CA.Add TBxCRest5, "CRD5", Format:="0 000.00 €"
   CA.Add TBxCEch5, "Echéance Mensuel5", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCPens, "Pensions"

   CA.Add CBxIProp1, "Propriétaire1"
   CA.Add TBxIDes1, "Désignation1"
   CA.Add TBxIVal1, "Valeur Actuelle1", Format:="0 000.00 €"
   CA.Add TBxIAdr1, "Adresse1"
   CA.Add TBxILoy1, "Loyer Perçu1", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp2, "Propriétaire2"
   CA.Add TBxIDes2, "Désignation2"
   CA.Add TBxIVal2, "Valeur Actuelle2", Format:="0 000.00 €"
   CA.Add TBxIAdr2, "Adresse2"
   CA.Add TBxILoy2, "Loyer Perçu2", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp3, "Propriétaire3"
   CA.Add TBxIDes3, "Désignation3"
   CA.Add TBxIVal3, "Valeur Actuelle3", Format:="0 000.00 €"
   CA.Add TBxIAdr3, "Adresse3"
   CA.Add TBxILoy3, "Loyer Perçu3", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp4, "Propriétaire3"
   CA.Add TBxIDes4, "Désignation4"
   CA.Add TBxIVal4, "Valeur Actuelle4", Format:="0 000.00 €"
   CA.Add TBxIAdr4, "Adresse4"
   CA.Add TBxILoy4, "Loyer Perçu4", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp5, "Propriétaire5"
   CA.Add TBxIDes5, "Désignation5"
   CA.Add TBxIVal5, "Valeur Actuelle5", Format:="0 000.00 €"
   CA.Add TBxIAdr5, "Adresse5"
   CA.Add TBxILoy5, "Loyer Perçu5", Format:="0 000.00 €", Mode:="CalcLab"

   CA.Add CBxPATit1, "Titulaire1"
   CA.Add CBxPADes1, "Désignation type1"
   CA.Add TBxPAOrg1, "Organisme1"
   CA.Add TBxPAMon1, "Montant Actuelle1", Format:="0 000.00 €"
   CA.Add TBxPADat1, "Date ouverture1"
   CA.Add TBxPAEpm1, "Epargne Mensuel1", Format:="0 000.00 €"
   CA.Add CBxPATit2, "Titulaire2"
   CA.Add CBxPADes2, "Désignation type2"
   CA.Add TBxPAOrg2, "Organisme2"
   CA.Add TBxPAMon2, "Montant Actuelle2", Format:="0 000.00 €"
   CA.Add TBxPADat2, "Date ouverture2"
   CA.Add TBxPAEpm2, "Epargne Mensuel2", Format:="0 000.00 €"
   CA.Add CBxPATit3, "Titulaire3"
   CA.Add CBxPADes3, "Désignation type3"
   CA.Add TBxPAOrg3, "Organisme3"
   CA.Add TBxPAMon3, "Montant Actuelle3", Format:="0 000.00 €"
   CA.Add TBxPADat3, "Date ouverture3"
   CA.Add TBxPAEpm3, "Epargne Mensuel3", Format:="0 000.00 €"
   CA.Add CBxPATit4, "Titulaire4"
   CA.Add CBxPADes4, "Désignation type4"
   CA.Add TBxPAOrg4, "Organisme4"
   CA.Add TBxPAMon4, "Montant Actuelle4", Format:="0 000.00 €"
   CA.Add TBxPADat4, "Date ouverture4"
   CA.Add TBxPAEpm4, "Epargne Mensuel4", Format:="0 000.00 €"

   CL.Add CBxMandat, "Mandat"
   CL.Add CBxPRef, "Réf Projet"
   CA.Add TBxPDaRef, "Date Ref Projet"
   CA.Add CBxPTypo, "Type Opération"
   CA.Add CBxPUsag, "Usage"
   CA.Add TBxPDaOC, "DAOC"
   CA.Add TBxPDaDD, "DADD"
   CA.Add TBxPDaAP, "DAAP"
   CA.Add TBxPDaSN, "DASN"
   CA.Add TBxPAdr1, "Adresse P1"
   CA.Add TBxPAdr2, "Adresse P2"
   CA.Add TBxPCP, "CP P2"
   CA.Add TBxPVille, "Ville P2"
   CA.Add TBxPTer, "Terrain", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPVia, "Viabilisation", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPAcq, "Acquisition Construction", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPTra, "Travaux", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPMob, "Mobilier", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPAge, "Frais Agence", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPNot, "Frais de Notaire", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPCRddate, "Date CRD"
   CA.Add TBxPCRd, "CRD", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPIra, "IRA", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPFga, "Frais de Garantie", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPFdo, "Frais de dossier", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPHon, "Honoraires", Format:="0 000.00 €", Mode:="CalcLab"

   CA.Add TBxFApp, "Apport", Format:="0 000.00 €"
   CA.Add TBxFPtz, "PTZ", Format:="0 000.00 €"
   CA.Add TBxFPem1, "Prêt Employeur 1", Format:="0 000.00 €"
   CA.Add TBxFPem2, "Prêt Employeur 2", Format:="0 000.00 €"
   CA.Add TBxFPpri, "Prêt Principal", Format:="0 000.00 €"
   CA.Add TBxFautr1, "Autre1", Format:="0 000.00 €"
   CA.Add TBxFautr2, "Autre2", Format:="0 000.00 €"

   'CA.Add TBxSRev, "Total Revenus", Format:="0 000.00 €"
   'CA.Add TBxSChar, "Total Charges", Format:="0 000.00 €"
   'CA.Add TBxSEnd, "Taux End Act", Format:="00 %", Mode:="RougeGras" 'CA.Add TBxSEnd, "Taux End Act", Format:="00 %"
   'CA.Add TBxSMen, "Mensualité possible", Format:="0 000.00 €"
   'CA.Add TBxPTota, "Total Projet", Format:="0 000.00 €"
   'CA.Add TBxFTota, "Total Financement", Format:="0 000.00 €"    '.Text = Format(TVLF(1, 197), "0.00 €")

   CL.CouleurSympa
   CL.Actualiser
   'If Not Me.ActiveControl Is FrmC Then CL.Stopper

   End Sub
Private Sub CA_Change(ByVal CAM As CAsso)
   If IsMissing(CAM.Mode) Then Exit Sub
   If CAM.Mode = "CalcLab" Then CA.ValeursVers TVL: GarnirLabel
   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)
   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 GarnirLabel()
   Dim Revenus As Currency, Charges As Currency, Endettement As Currency, Projet As Currency, Financement As Currency
   Revenus = TVL(1, 33) + TVL(1, 71) + TVL(1, 113) * 0.7 + TVL(1, 118) * 0.7 + TVL(1, 123) * 0.7 + TVL(1, 128) * 0.7 + TVL(1, 133) * 0.7
   Charges = TVL(1, 16) + TVL(1, 54) + TVL(1, 83) + TVL(1, 89) + TVL(1, 95) + TVL(1, 101) + TVL(1, 107)
   Endettement = Charges / Revenus
   Projet = TVL(1, 171) + TVL(1, 172) + TVL(1, 173) + TVL(1, 174) + TVL(1, 175) + TVL(1, 176) + TVL(1, 177) + TVL(1, 179) + TVL(1, 180) + TVL(1, 181) + TVL(1, 182) + TVL(1, 183)
   Financement = TVL(1, 184) + TVL(1, 185) + TVL(1, 186) + TVL(1, 187) + TVL(1, 188) + TVL(1, 189) + TVL(1, 190)
   LabRevenus.Caption = Format(Revenus, "0 000.00 €")
   LabCharges.Caption = Format(Charges, "0 000.00 €")
   LabEndettement.Caption = Format(Endettement, "0.00 %")
   If Endettement > 0.33 Then
      LabEndettement.ForeColor = vbRed: LabEndettement.Font.Bold = True
   Else
      LabEndettement.ForeColor = 0: LabEndettement.Font.Bold = False
      End If
   LabMensualité.Caption = Format(Revenus * 0.33, "0 000.00 €")
   LabProjet.Caption = Format(Projet, "0 000.00 €")
   LabFinancement.Caption = Format(Financement, "0 000.00 €")
   End Sub
  
Private Sub CBnEffacer_Click()
   CL.Nettoyer
   End Sub
Private Sub CBnAjouter_Click()
   CL.ValeursVers TVL
   CA.ValeursVers TVL
   CL.Lignes(LCou).Range.Resize(, 190).Value = TVL
   CL.Actualiser
   End Sub
Private Sub CBnModifier_Click()
   CA.ValeursVers TVL
   CL.Lignes(LCou).Range.Resize(, 190).Value = TVL
   End Sub
Private Sub CBnSupprimer_Click()
   CL.Lignes(LCou).Delete
   CL.Actualiser
   End Sub

Dranreb · 14 Avril 2020

Bonjour.
L'erreur qui me saute aux yeux dans la CBnAjouter_Click c'est
CL.Lignes(LCou).Range.Resize(, 190).Value = TVL au lieu de
CL.Lignes.Add.Range.Resize(, 190).Value = TVL

CL.Lignes(LCou) renvoie le ListRow existant à la position LCou de la collection Lignes tandis que
CL.Lignes.Add renvoie un ListRow venant d'y être ajouté.
Lignes est initialisé à LOt.ListRows dans ComboBoxLiées, LOt étant le ListObject qui couvre le tableau.

gbstyle · 14 Avril 2020

Ah oui en effet, bizarre
dis est ce qu'il est possible que les valeur puisse etre considérer à zéro quand je ne remplis pas tout les champs calculé, car dans ma facon de procéder je reviendrai parfois 2 à 3 fois pour avoir une fiche client remplis à 100%
car la quand je crée un nom sans remplir toute les infos je pense que j'ai une erreur sur les label ?

gbstyle · 14 Avril 2020

En ce qui concerne cette ligne
TVL(1, 1) = WorkseetFunction.Max(CL.Colonnes("Réf").DataBodyRange) + 1
pour l'incrémentation automatique je dois l'intégrer à l'initialisation du useforme je pense

Dranreb · 14 Avril 2020

il serait souhaitable d'éviter la division par zéro.
Non, avant le CL.Lignes.Add.Range.Resize(, 190).Value = TVL dans la CBnAjouter_Click
Éventuellement ça pourrait se mettre aussi après le Redim TVL dans la CL_Change si on veut voir le numéro qui sera appliqué.

gbstyle · 14 Avril 2020

A prioris ca ne fonctionne pas est ce du au faite que ce soit une Comboxlié ?

Dranreb · 14 Avril 2020

J'ai mis "Réf" un peu au hasard. C'est bien l'entête de la colonne, au moins ?
Si oui, qu'est-ce qui coince ?
Rappel, il est aussi possible de spécifer au WorksheetFunction.Max la bonne colonne de CL.PlgTablo. C'est peut être plus simple, finalement puisqu'on n'a de toute façon pas pu éviter de spécifier des numéros de colonnes de TVL.

gbstyle · 15 Avril 2020

Bonjour Dranreb alors en effet c'est bien l'entête de la colonne Réf
ce qui ne marche pas c'est l'incrémentation automatique de cette valeur
Ensuite je pensait au faite à la division par 0, serait t'il pas possible de mettre par défaut une valeur tel que 1 dans les Txtbox concerné à la création d'une nouvelle fiche ce qui ferai une valeur résultat de 1 et donc plus de 0

VB:

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 CBxRefClient, "Réf"
   CL.Add CBxNom, "Nom", "&", Croissant:=False
   CA.Add TBxNomjf, "Nom Jeune Fille"
   CA.Add TBxPrénom, "Prénom"
   CA.Add TBxDatenaiss, "Date Naissance"
   CA.Add TBxLieunaiss, "Lieu Naissance"
   CA.Add TBxDeptnaiss, "Dept Naissance"
   CA.Add CBxSitufam, "Situ Famille"
   CA.Add CBxContrat, "Contrat Mariage"
   CA.Add TBxDatecontrat, "Date Contrat"
   CA.Add TBxEnfants, "Enfants"
   CA.Add TBxAdract, "Adresse Act"
   CA.Add TBxCP, "CP Act"
   CA.Add TBxVille, "Ville Act"
   CA.Add CBxRP, "Résidence Principale"
   CA.Add TBxLoyer, "Loyer", Format:="0 000.00 €"
   CA.Add TBxLoyerdepuis, "Date loyer"
   CA.Add TBxTel, "Telephone", Format:="00 00 00 00 00"
   CA.Add TBxEmail, "Email"
   CA.Add TBxProfession, "Profession"
   CA.Add TBxEmployeur, "Employeur"
   CA.Add CBxTypecont, "Type Contrat"
   CA.Add CBxStatut, "Statut"
   CA.Add TBxAnciennete, "Ancienneté"
   CA.Add TBxPays, "Pays"
   CA.Add TBxNationalite, "Nationalité"

   CA.Add CBxIBBanque, "Banque"
   CA.Add TBxIBAgen, "Agence"
   CA.Add TBxIBAdr, "Adr Agence"
   CA.Add TBxIBCP, "CP Agence"
   CA.Add TBxIBVille, "Ville Agence"
   CA.Add TBxIBNom, "Nom Conseiller"

   CA.Add TBxRSalaire, "Salaire", Format:="0 000.00 €", Mode:="CalcLab"  '= Format(("Salaire"), "0.00 €")  '(Format("Echéance Mensuel1", "0,00€"))
   CA.Add TBxRAlloc, "Allocation", Format:="0 000.00 €"
   CA.Add TBxRRFoncier, "Revenus Foncier", Format:="0 000.00 €"
   CA.Add TBxRPensions, "Pensions", Format:="0 000.00 €"
   CA.Add TBxRRFRN1, "RFR N-1", Format:="0 000.00 €"
   CA.Add TBxRRFRN2, "RFR N-2", Format:="0 000.00 €"
   CA.Add TBxRIRPP, "IRPP", Format:="0 000.00 €"

   CL.Add CBxNom2, "Nom2"
   CA.Add TBxNomjf2, "Nom Jeune Fille2"
   CA.Add TBxPrénom2, "Prénom2"
   CA.Add TBxDatenaiss2, "Date Naissance2"
   CA.Add TBxLieunaiss2, "Lieu Naissance2"
   CA.Add TBxDeptnaiss2, "Dept Naissance2"
   CA.Add CBxSitufam2, "Situ Famille2"
   CA.Add CBxContrat2, "Contrat Mariage2"
   CA.Add TBxDatecontrat2, "Date Contrat2"
   CA.Add TBxEnfants2, "Enfants2"
   CA.Add TBxAdract2, "Adresse Act2"
   CA.Add TBxCP2, "CP Act2"
   CA.Add TBxVille2, "Ville Act2"
   CA.Add CBxRP2, "Résidence Principale2"
   CA.Add TBxLoyer2, "Loyer2", Format:="0 000.00 €"
   CA.Add TBxLoyerdepuis2, "Date loyer2"
   CA.Add TBxTel2, "Telephone2", Format:="00 00 00 00 00"
   CA.Add TBxEmail2, "email2"
   CA.Add TBxProfession2, "Profession2"
   CA.Add TBxEmployeur2, "Employeur2"
   CA.Add CBxTypecont2, "Type Contrat2"
   CA.Add CBxStatut2, "Statut2"
   CA.Add TBxAnciennete2, "Ancienneté2"
   CA.Add TBxPays2, "Pays2"
   CA.Add TBxNationalite2, "Nationalité2"

   CA.Add CBxIBBanque2, "Banque2"
   CA.Add TBxIBAgen2, "Agence2"
   CA.Add TBxIBAdr2, "Adr Agence2"
   CA.Add TBxIBCP2, "CP Agence2"
   CA.Add TBxIBVille2, "Ville Agence2"
   CA.Add TBxIBNom2, "Nom Conseiller2"

   CA.Add TBxRSalaire2, "Salaire2", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxRAlloc2, "Allocation2", Format:="0 000.00 €"
   CA.Add TBxRRFoncier2, "Revenus Foncier2", Format:="0 000.00 €"
   CA.Add TBxRPensions2, "Pensions2", Format:="0 000.00 €"
   CA.Add TBxRRFRN12, "RFR N-12", Format:="0 000.00 €"
   CA.Add TBxRRFRN22, "RFR N-22", Format:="0 000.00 €"
   CA.Add TBxRIRPP2, "IRPP2", Format:="0 000.00 €"

   CA.Add TBxCNom1, "Nom Prêteur1"
   CA.Add CBxCNat1, "Nature du Prêt1"
   CA.Add TBxCDatreal1, "Date de Réalisation1", Format:="mmm.yy"
   CA.Add TBxCDatfin1, "Date de fin1", Format:="mmm.yy"
   CA.Add TBxCRest1, "CRD1", Format:="0 000.00 €"
   CA.Add TBxCEch1, "Echéance Mensuel1", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom2, "Nom Prêteur2"
   CA.Add CBxCNat2, "Nature du Prêt2"
   CA.Add TBxCDatreal2, "Date de Réalisation2", Format:="mmm.yy"
   CA.Add TBxCDatfin2, "Date de fin2", Format:="mmm.yy"
   CA.Add TBxCRest2, "CRD2", Format:="0 000.00 €"
   CA.Add TBxCEch2, "Echéance Mensuel2", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom3, "Nom Prêteur3"
   CA.Add CBxCNat3, "Nature du Prêt3"
   CA.Add TBxCDatreal3, "Date de Réalisation3", Format:="mmm.yy"
   CA.Add TBxCDatfin3, "Date de fin3", Format:="mmm.yy"
   CA.Add TBxCRest3, "CRD3", Format:="0 000.00 €"
   CA.Add TBxCEch3, "Echéance Mensuel3", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom4, "Nom Prêteur4"
   CA.Add CBxCNat4, "Nature du Prêt4"
   CA.Add TBxCDatreal4, "Date de Réalisation4", Format:="mmm.yy"
   CA.Add TBxCDatfin4, "Date de fin4", Format:="mmm.yy"
   CA.Add TBxCRest4, "CRD4", Format:="0 000.00 €"
   CA.Add TBxCEch4, "Echéance Mensuel4", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCNom5, "Nom Prêteur5"
   CA.Add CBxCNat5, "Nature du Prêt5"
   CA.Add TBxCDatreal5, "Date de Réalisation5", Format:="mmm.yy"
   CA.Add TBxCDatfin5, "Date de fin5", Format:="mmm.yy"
   CA.Add TBxCRest5, "CRD5", Format:="0 000.00 €"
   CA.Add TBxCEch5, "Echéance Mensuel5", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxCPens, "Pensions"

   CA.Add CBxIProp1, "Propriétaire1"
   CA.Add TBxIDes1, "Désignation1"
   CA.Add TBxIVal1, "Valeur Actuelle1", Format:="0 000.00 €"
   CA.Add TBxIAdr1, "Adresse1"
   CA.Add TBxILoy1, "Loyer Perçu1", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp2, "Propriétaire2"
   CA.Add TBxIDes2, "Désignation2"
   CA.Add TBxIVal2, "Valeur Actuelle2", Format:="0 000.00 €"
   CA.Add TBxIAdr2, "Adresse2"
   CA.Add TBxILoy2, "Loyer Perçu2", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp3, "Propriétaire3"
   CA.Add TBxIDes3, "Désignation3"
   CA.Add TBxIVal3, "Valeur Actuelle3", Format:="0 000.00 €"
   CA.Add TBxIAdr3, "Adresse3"
   CA.Add TBxILoy3, "Loyer Perçu3", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp4, "Propriétaire3"
   CA.Add TBxIDes4, "Désignation4"
   CA.Add TBxIVal4, "Valeur Actuelle4", Format:="0 000.00 €"
   CA.Add TBxIAdr4, "Adresse4"
   CA.Add TBxILoy4, "Loyer Perçu4", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add CBxIProp5, "Propriétaire5"
   CA.Add TBxIDes5, "Désignation5"
   CA.Add TBxIVal5, "Valeur Actuelle5", Format:="0 000.00 €"
   CA.Add TBxIAdr5, "Adresse5"
   CA.Add TBxILoy5, "Loyer Perçu5", Format:="0 000.00 €", Mode:="CalcLab"

   CA.Add CBxPATit1, "Titulaire1"
   CA.Add CBxPADes1, "Désignation type1"
   CA.Add TBxPAOrg1, "Organisme1"
   CA.Add TBxPAMon1, "Montant Actuelle1", Format:="0 000.00 €"
   CA.Add TBxPADat1, "Date ouverture1"
   CA.Add TBxPAEpm1, "Epargne Mensuel1", Format:="0 000.00 €"
   CA.Add CBxPATit2, "Titulaire2"
   CA.Add CBxPADes2, "Désignation type2"
   CA.Add TBxPAOrg2, "Organisme2"
   CA.Add TBxPAMon2, "Montant Actuelle2", Format:="0 000.00 €"
   CA.Add TBxPADat2, "Date ouverture2"
   CA.Add TBxPAEpm2, "Epargne Mensuel2", Format:="0 000.00 €"
   CA.Add CBxPATit3, "Titulaire3"
   CA.Add CBxPADes3, "Désignation type3"
   CA.Add TBxPAOrg3, "Organisme3"
   CA.Add TBxPAMon3, "Montant Actuelle3", Format:="0 000.00 €"
   CA.Add TBxPADat3, "Date ouverture3"
   CA.Add TBxPAEpm3, "Epargne Mensuel3", Format:="0 000.00 €"
   CA.Add CBxPATit4, "Titulaire4"
   CA.Add CBxPADes4, "Désignation type4"
   CA.Add TBxPAOrg4, "Organisme4"
   CA.Add TBxPAMon4, "Montant Actuelle4", Format:="0 000.00 €"
   CA.Add TBxPADat4, "Date ouverture4"
   CA.Add TBxPAEpm4, "Epargne Mensuel4", Format:="0 000.00 €"

   CL.Add CBxMandat, "Mandat"
   CL.Add CBxPRef, "Réf Projet"
   CA.Add TBxPDaRef, "Date Ref Projet"
   CA.Add CBxPTypo, "Type Opération"
   CA.Add CBxPUsag, "Usage"
   CA.Add TBxPDaOC, "DAOC"
   CA.Add TBxPDaDD, "DADD"
   CA.Add TBxPDaAP, "DAAP"
   CA.Add TBxPDaSN, "DASN"
   CA.Add TBxPAdr1, "Adresse P1"
   CA.Add TBxPAdr2, "Adresse P2"
   CA.Add TBxPCP, "CP P2"
   CA.Add TBxPVille, "Ville P2"
   CA.Add TBxPTer, "Terrain", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPVia, "Viabilisation", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPAcq, "Acquisition Construction", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPTra, "Travaux", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPMob, "Mobilier", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPAge, "Frais Agence", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPNot, "Frais de Notaire", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPCRddate, "Date CRD"
   CA.Add TBxPCRd, "CRD", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPIra, "IRA", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPFga, "Frais de Garantie", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPFdo, "Frais de dossier", Format:="0 000.00 €", Mode:="CalcLab"
   CA.Add TBxPHon, "Honoraires", Format:="0 000.00 €", Mode:="CalcLab"

   CA.Add TBxFApp, "Apport", Format:="0 000.00 €"
   CA.Add TBxFPtz, "PTZ", Format:="0 000.00 €"
   CA.Add TBxFPem1, "Prêt Employeur 1", Format:="0 000.00 €"
   CA.Add TBxFPem2, "Prêt Employeur 2", Format:="0 000.00 €"
   CA.Add TBxFPpri, "Prêt Principal", Format:="0 000.00 €"
   CA.Add TBxFautr1, "Autre1", Format:="0 000.00 €"
   CA.Add TBxFautr2, "Autre2", Format:="0 000.00 €"

   'CA.Add TBxSRev, "Total Revenus", Format:="0 000.00 €"
   'CA.Add TBxSChar, "Total Charges", Format:="0 000.00 €"
   'CA.Add TBxSEnd, "Taux End Act", Format:="00 %", Mode:="RougeGras" 'CA.Add TBxSEnd, "Taux End Act", Format:="00 %"
   'CA.Add TBxSMen, "Mensualité possible", Format:="0 000.00 €"
   'CA.Add TBxPTota, "Total Projet", Format:="0 000.00 €"
   'CA.Add TBxFTota, "Total Financement", Format:="0 000.00 €"    '.Text = Format(TVLF(1, 197), "0.00 €")

   CL.CouleurSympa
   CL.Actualiser
   'If Not Me.ActiveControl Is FrmC Then CL.Stopper

   End Sub
Private Sub CA_Change(ByVal CAM As CAsso)
   If IsMissing(CAM.Mode) Then Exit Sub
   If CAM.Mode = "CalcLab" Then CA.ValeursVers TVL: GarnirLabel
   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.PlgTablo.Columns(1)) + 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 GarnirLabel()
   Dim Revenus As Currency, Charges As Currency, Endettement As Currency, Projet As Currency, Financement As Currency
   Revenus = TVL(1, 33) + TVL(1, 71) + TVL(1, 113) * 0.7 + TVL(1, 118) * 0.7 + TVL(1, 123) * 0.7 + TVL(1, 128) * 0.7 + TVL(1, 133) * 0.7
   Charges = TVL(1, 16) + TVL(1, 54) + TVL(1, 83) + TVL(1, 89) + TVL(1, 95) + TVL(1, 101) + TVL(1, 107)
   Endettement = Charges / Revenus
   Projet = TVL(1, 171) + TVL(1, 172) + TVL(1, 173) + TVL(1, 174) + TVL(1, 175) + TVL(1, 176) + TVL(1, 177) + TVL(1, 179) + TVL(1, 180) + TVL(1, 181) + TVL(1, 182) + TVL(1, 183)
   Financement = TVL(1, 184) + TVL(1, 185) + TVL(1, 186) + TVL(1, 187) + TVL(1, 188) + TVL(1, 189) + TVL(1, 190)
   LabRevenus.Caption = Format(Revenus, "0 000.00 €")
   LabCharges.Caption = Format(Charges, "0 000.00 €")
   LabEndettement.Caption = Format(Endettement, "0.00 %")
   If Endettement > 0.33 Then
      LabEndettement.ForeColor = vbRed: LabEndettement.Font.Bold = True
   Else
      LabEndettement.ForeColor = 0: LabEndettement.Font.Bold = False
      End If
   LabMensualité.Caption = Format(Revenus * 0.33, "0 000.00 €")
   LabProjet.Caption = Format(Projet, "0 000.00 €")
   LabFinancement.Caption = Format(Financement, "0 000.00 €")
   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.PlgTablo.Columns(1)) + 1
   CL.Lignes.Add.Range.Resize(, 190).Value = TVL
   CL.Actualiser
   End Sub
Private Sub CBnModifier_Click()
   CA.ValeursVers TVL
   CL.Lignes(LCou).Range.Resize(, 190).Value = TVL
   End Sub
Private Sub CBnSupprimer_Click()
   CL.Lignes(LCou).Delete
   CL.Actualiser
   End Sub
  
'Private Sub CBnAnamnèse_Click()
   'UFmAnamnèse.Show
   'End Sub
'Private Sub CBnExamenPieds_Click()
   'UFmExamenPieds.Show
   'End Sub
'Private Sub CBnPhotos_Click()
   'UFmPhotos.Show
   'End Sub
'Private Sub CBnSoinsEffec_Click()
   'UFmSoins.Show
   'End Sub

gbstyle · 15 Avril 2020

Les valeur Salaire de l'emprunteur au moin la textbox loyer à 1€
A moin que tu es une autre solution pour éviter la division par 0

Dranreb · 15 Avril 2020

Bonjour.
Met un point d'arrêt au début de la CBnAjouter et des espions partout. Là je ne vois pas, ça devrait normalement marcher. À moins qu'il n'y ait que des textes composé de chiffres au lieu de numéros dans les ligne existantes ?
Oui; c'est tellement simple de le tester juste avant de faire la division, que je ne comprends pas pourquoi tu veux faire autre chose ?

gbstyle · 15 Avril 2020

je ne voulais pas tester autre chose c'est que je ne sais pas comment faire pour tester juste avant la division :/
pour le point d'arret j'ai mis un point d'arret et des espions sur les expressions de la cbn ajouter mais je ne vois pas ce qu'il faut faire par la suite car à prioris rien ne ressort en dysfonctionnement c'est propablement du à une manipulation que je fais

Dranreb · 15 Avril 2020

Comment tu ne sais toujours pas écrire une instruction If ???

gbstyle · 16 Avril 2020

bah moi je voyais quelque chose de simple comme ceci
If Charges = 0 Then Exit Sub
avant le calcul de
Endettement = Charges / Revenus
mais je ne pense pas que ce soit la solution :/ malgré que ca fonctionne

Par contre impossible de réussir d'incrémenter le +1 pour la réf :/ mais comme tu dis dans le tableau pour que la valeur soit crédit elle sont stocké sous forme de texte pour avoir le 0001 sinon en nombre il me met par défaut 1

Effectuez une recherche sur Excel Downloads...

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

gbstyle

XLDnaute Impliqué

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

gbstyle

XLDnaute Impliqué

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums