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