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 · 9 Avril 2020

Tu m'avais proposé cette solution

VB:

Private Sub CA_Change(ByVal CAM As CAsso)
   If CAM.Mode = "RougeGras" Then
      If VarType(CAM.Valeur) = vbDouble Then
          Select Case CAM.Valeur
             Case Is > 0.33: CAM.Ctl.ForeColor = vbRed: CAM.Ctl.Font.Bold = True
             Case Else: CAM.Ctl.ForeColor = 0: CAM.Ctl.Font.Bold = False
             End Select
      End If
   End If
   End Sub

gbstyle · 9 Avril 2020

Dranreb à dit:
Non, on n'a pas changé jusqu’à présent d'autres propriétés des Label que leur Caption.
Mais là je reviens sur ce que j'ai dit: Si l'endettement doit donner lieu à des changement de leur apparence, il est aussi souhaitable de le calculer d'abord dans une variable.

D'accord donc je déclare une variable dans la garnirLAbel
par contre je déclare Endettement As Currency ?
Bon je vais essayer mais pas sur du résultat ;/ vu que tout à l'heure j'ai déjà échoué

Dranreb · 9 Avril 2020

Oui, mais il faut mettre ce Select Case dans la Sub GarnirLabel, avec le nom du Label à la place de CAM.Ctl. Parce que la seule instruction de la CA_Change sera celle indiquée au #924, vu qu'elle devra jouer son rôle quand ce sera un autre contrôle que le Label qui changera.

gbstyle · 9 Avril 2020

Private Sub GarnirLabel()
Dim Revenus As Currency, Charges As Currency, Endettement 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)
LabRevenus = Format(Revenus, "0 000.00 ?")
Charges = (TVL(1, 16) + TVL(1, 54) + TVL(1, 83) + TVL(1, 89) + TVL(1, 95) + TVL(1, 101) + TVL(1, 107))
LabCharges = Format(Charges, "0 000.00 ?")
Endettement = (Charges / Revenus)
LabEndettement = Format(Endettement, "0.00 %") 'LabEndettement.Caption = Format(Charges / Revenus, "0.00 %")
LabMensualit?.Caption = Format(Revenus * 0.33, "0 000.00 ?")
End Sub
A prioris cela fonctionne pour l'instant
maintenant je vais regarder ton commentaire avec le select et le post 924

Dranreb · 9 Avril 2020

Pas besoin de parenthèses : Endettement = Charges / Revenus
D'ailleurs pour les autres calculs non plus. Ça alourdit inutilement à mon avis.

gbstyle · 9 Avril 2020

Je dois dire que je suis un peu perdu avec ce post 924 je n'arrive pas très bien a assimiler ce que tu me demande
j'ai supprimé les parenthèse dslé pour cet erreur, par contre à l'initialisation de l'userform j'ai supprimé les CA des textbox que l'on as remplacé par les label mais je les ai pas noté

VB:

Option Explicit
Private WithEvents CL As ComboBoxLiées, 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 €"  '= 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 €"
   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 €"
   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 €"
   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 €"
   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 €"
   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 €"
   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 €"
   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 €"
   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 €"
   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 €"
   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 €"

   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 €"
   CA.Add TBxPVia, "Viabilisation", Format:="0 000.00 €"
   CA.Add TBxPAcq, "Acquisition Construction", Format:="0 000.00 €"
   CA.Add TBxPTra, "Travaux", Format:="0 000.00 €"
   CA.Add TBxPMob, "Mobilier", Format:="0 000.00 €"
   CA.Add TBxPAge, "Frais Agence", Format:="0 000.00 €"
   CA.Add TBxPNot, "Frais de Notaire", Format:="0 000.00 €"
   CA.Add TBxPCRddate, "Date CRD"
   CA.Add TBxPCRd, "CRD", Format:="0 000.00 €"
   CA.Add TBxPIra, "IRA", Format:="0 000.00 €"
   CA.Add TBxPFga, "Frais de Garantie", Format:="0 000.00 €"
   CA.Add TBxPFdo, "Frais de dossier", Format:="0 000.00 €"
   CA.Add TBxPHon, "Honoraires", Format:="0 000.00 €"

   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 CAM.Mode = "RougeGras" Then
      If VarType(CAM.Valeur) = vbDouble Then
          Select Case CAM.Valeur
             Case Is > 0.33: CAM.Ctl.ForeColor = vbRed: CAM.Ctl.Font.Bold = True
             Case Else: CAM.Ctl.ForeColor = 0: CAM.Ctl.Font.Bold = False
             End Select
             'If CAM.Mode = "CalcLab" Then CA.ValeursVers TVL: GarnirLabel
      End If
   End If
   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)
   CA.ValeursDepuis TVL

   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
   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
   LabRevenus = Format(Revenus, "0 000.00 €")
   Charges = TVL(1, 16) + TVL(1, 54) + TVL(1, 83) + TVL(1, 89) + TVL(1, 95) + TVL(1, 101) + TVL(1, 107)
   LabCharges = Format(Charges, "0 000.00 €")
   Endettement = Charges / Revenus
   LabEndettement = Format(Endettement, "0.00 %") 'LabEndettement.Caption = Format(Charges / Revenus, "0.00 %")
   LabMensualité.Caption = Format(Revenus * 0.33, "0 000.00 €")

   End Sub

Dranreb · 9 Avril 2020

Manque les , Mode:="CalcLab" dans les CA.Add des TextBox qui doivent déclencher le calcul quand on les changera.

gbstyle · 9 Avril 2020

c'est à dire que tout les CA concerné ex :
CA.Add TBxRSalaire, "Salaire", Format:="0 000.00 "
je dois leur ajouter Mode:="CalcLab"
CA.Add TBxRSalaire, "Salaire", Format:="0 000.00 " , Mode:="CalcLAb"
???
désolé mais pas très simple pour moi

Dranreb · 9 Avril 2020

Oui. Pour tout ceux qui devront déclencher le calcul.
Autre chose: il manque toujours l'attribut WithEvents devant CA dans sa déclaration, pour que ses évènements puissent être pris en charge. Là CA ne figure même pas dans la liste déroulante de gauche, il faut cet attribut pour qu'il y soit.

gbstyle · 9 Avril 2020

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 €"
   CA.Add TBxPVia, "Viabilisation", Format:="0 000.00 €"
   CA.Add TBxPAcq, "Acquisition Construction", Format:="0 000.00 €"
   CA.Add TBxPTra, "Travaux", Format:="0 000.00 €"
   CA.Add TBxPMob, "Mobilier", Format:="0 000.00 €"
   CA.Add TBxPAge, "Frais Agence", Format:="0 000.00 €"
   CA.Add TBxPNot, "Frais de Notaire", Format:="0 000.00 €"
   CA.Add TBxPCRddate, "Date CRD"
   CA.Add TBxPCRd, "CRD", Format:="0 000.00 €"
   CA.Add TBxPIra, "IRA", Format:="0 000.00 €"
   CA.Add TBxPFga, "Frais de Garantie", Format:="0 000.00 €"
   CA.Add TBxPFdo, "Frais de dossier", Format:="0 000.00 €"
   CA.Add TBxPHon, "Honoraires", Format:="0 000.00 €"

   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 CAM.Mode = "CalcLab" Then
      If VarType(CAM.Valeur) = vbDouble Then
          Select Case CAM.Valeur
             Case Is > 0.33: CAM.Ctl.ForeColor = vbRed: CAM.Ctl.Font.Bold = True
             Case Else: CAM.Ctl.ForeColor = 0: CAM.Ctl.Font.Bold = False
             End Select
             'If CAM.Mode = "CalcLab" Then CA.ValeursVers TVL: GarnirLabel
      End If
   End If
   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)
   CA.ValeursDepuis TVL

   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
   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
   LabRevenus = Format(Revenus, "0 000.00 €")
   Charges = TVL(1, 16) + TVL(1, 54) + TVL(1, 83) + TVL(1, 89) + TVL(1, 95) + TVL(1, 101) + TVL(1, 107)
   LabCharges = Format(Charges, "0 000.00 €")
   Endettement = Charges / Revenus
   LabEndettement = Format(Endettement, "0.00 %") 'LabEndettement.Caption = Format(Charges / Revenus, "0.00 %")
   LabMensualité.Caption = Format(Revenus * 0.33, "0 000.00 €")

   End Sub

Bon j'ai fait les modifs mais je comprend toujour pas la différence qu'il apporte dans le fonctionnement, de plus je n'arrive pas à comprendre la liaison avec le Label tx endettement pour sa mise en forme

Dranreb · 9 Avril 2020

La différence c'est que la CA_Change sera désormais exécutée si on change un contrôle pris en charge par CA, ce qui mettra à jour les Label s'il a le Mode:="CalcLab".

gbstyle · 9 Avril 2020

As tu pu le tester ? car je m'en rend pas bien compte.
Pour ma part pour voir les mise à jour je suis toujour obligé d'utiliser ce bouton raz et reselection mon nom pour voir les mise à jour :/

Dranreb · 9 Avril 2020

Non le but c'est aussi de prévisualiser dès qu'on change un contrôle dépendant.
Tu peut mettre un point d'arrêt dans la CA_Change et dérouler en pas à pas.

gbstyle · 9 Avril 2020

ah si tu peux tester tu me rediras ce que tu en penses, car je suis pas sur que cela fonctionne.
une manip a faire tu modifie juste le salaire de l'emprunteur et tu met mille, tu verras que les labels ne se modifie pas hormis en cliquant sur ras et reselection, et que la mise en forme du taux >à 33% ne se met pas en forme
si tu veux je te renvois le fichier à jour

Dranreb · 9 Avril 2020

Je n'ai pas gardé le dernier fichier, renvoie le donc.

Effectuez une recherche sur Excel Downloads...

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

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

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