Option Explicit
Event Change(ByVal CAM As CAsso)
Event Click(ByVal CAM As CAsso)
Event KeyDown(ByVal CAM As CAsso, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Event KeyPress(ByVal CAM As CAsso, ByVal KeyAscii As MSForms.ReturnInteger)
Event KeyUp(ByVal CAM As CAsso, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Private LCs As ListColumns, TCAssos() As CAsso, NePasExécuterChange As Boolean
Property Set Colonnes(ByVal LCsTab As ListColumns)
' — Affectez par un Set à .Colonnes la .LiscColumns du ListObject traité ou bien la .Colonnes d'un
' ComboBoxLiées si vous voulez pouvoir spécifier ses titres aux Add en guise de Colonne.
Set LCs = LCsTab
End Property
Public Sub Add(ByVal Ctl As MSForms.Control, Optional ByVal Colonne As Variant = -1, _
Optional ByVal Format As String = "", Optional ByVal Mode = Empty)
' — Arguments :
' Ctl : Le contrôle à ajouter.
' Colonne : La colonne dans le tableau.
' Format : Le format de conversion de la valeur en le texte affiché dans le contrôle.
' Mode : Ce que vous aimeriez retrouver en CAM.Mode pour orienter un traitement d'évènement.
Dim I As Long
CorrigerColonne Colonne, "Add Me." & Ctl.Name
I = Me.Count + 1: ReDim Preserve TCAssos(1 To I) As CAsso
Select Case True
Case TypeOf Ctl Is MSForms.TextBox: Set TCAssos(I) = New CAssoTBx
Case TypeOf Ctl Is MSForms.ComboBox: Set TCAssos(I) = New CAssoCBx
Case TypeOf Ctl Is MSForms.OptionButton: MsgBox "Contrôle de type ""OptionButton"" non supporté," _
& vbLf & "mais un ""Frame"" en contenenant serait accepté.", _
vbCritical, "ControlsAssociés Add Me." & Ctl.Name: End
Case TypeOf Ctl Is MSForms.CheckBox: Set TCAssos(I) = New CassoCkx
Case TypeOf Ctl Is MSForms.Frame: Set TCAssos(I) = New CAssoFrm
Case TypeOf Ctl Is MSForms.Image: Set TCAssos(I) = New CAssoImg
Case Else: MsgBox "Contrôle de type """ & TypeName(Ctl) & """ non supporté actuellement", _
vbCritical, "ControlsAssociés Add Me." & Ctl.Name: End: End Select
TCAssos(I).Init Me, Ctl, I, Colonne, Format, Mode
End Sub
Public Function Count() As Long
On Error Resume Next: Count = UBound(TCAssos)
End Function
Public Function Item(ByVal Index As Variant) As CAsso
Dim I As Long, Nom As String
If IsObject(Index) Then
For I = 1 To UBound(TCAssos)
Set Item = TCAssos(I): If Item.Ctl Is Index Then Exit Function
Next I
Set Item = Nothing: On Error Resume Next: Nom = Index.Name: If Err Then Nom = "sans nom"
MsgBox "Cet objet " & Nom & " de type " & TypeName(Index) & " n'a pas fait l'objet d'un Add.", _
vbCritical, "ControlsAssociés.Item"
Else
Set Item = TCAssos(Index)
End If
End Function
Public Function NbRenseignés() As Long
Dim I As Long, C As Long
For I = 1 To UBound(TCAssos): NbRenseignés = NbRenseignés + 1 - IsEmpty(TCAssos(I).Valeur): Next I
End Function
Public Sub ValeursDepuis(T())
Dim I As Long, C As Long
NePasExécuterChange = True
For I = 1 To UBound(TCAssos)
C = TCAssos(I).Col: If C > 0 Then TCAssos(I).Valeur = T(1, C)
Next I
NePasExécuterChange = False
End Sub
Public Sub ValeursVers(T())
Dim I As Long, C As Long
For I = 1 To UBound(TCAssos)
C = TCAssos(I).Col: If C > 0 Then T(1, C) = TCAssos(I).Valeur
Next I
End Sub
Public Sub ÉcrireConstantes(ByVal OùÇa)
Dim RngDest As Range
Select Case True
Case TypeOf OùÇa Is Range: Set RngDest = OùÇa
Case TypeOf OùÇa Is ListRow: Set RngDest = OùÇa.Range
Case IsNumeric(OùÇa): Set RngDest = LCs.Parent.ListRows(OùÇa).Range
Case IsArray(OùÇa): MsgBox "Cette méthode a besoin d'un Range pour vérifier si" _
& vbLf & "ses cellules ne portent pas de formule à ne pas écraser." _
& vbLf & "Donc type " & TypeName(OùÇa) & "non supporté.", _
vbCritical, "ÉcrireConstantes": End
Case Else: MsgBox "Destination de type " & TypeName(OùÇa) & " non supportée.", _
vbCritical, "ÉcrireConstantes": End
End Select
Dim I As Long, C As Long
For I = 1 To UBound(TCAssos)
C = TCAssos(I).Col
If C > 0 And Not RngDest(1, C).HasFormula Then RngDest(1, C) = TCAssos(I).Valeur
Next I
End Sub
Public Function ValeurDifférente(T()) As Boolean
Dim I As Long, C As Long
For I = 1 To UBound(TCAssos)
C = TCAssos(I).Col: If C > 0 Then ValeurDifférente = TCAssos(I).Valeur <> T(1, C)
If ValeurDifférente Then Exit Function
Next I
End Function
Public Property Let Enabled(ByVal B As Boolean)
Dim I As Long
For I = 1 To UBound(TCAssos)
TCAssos(I).Ctl.Enabled = B
Next I
End Property
Private Sub CorrigerColonne(Colonne As Variant, ByVal TitreMsg As String)
On Error Resume Next
Select Case TypeName(Colonne)
Case "String": If LCs Is Nothing Then MsgBox "Colonne String interdite car Colonnes non initialisé.", _
vbCritical, TitreMsg: Exit Sub
Colonne = LCs(Colonne).Index
If Err Then MsgBox "Colonne """ & Colonne & """ inconnue dans " & LCs.Parent.Name, _
vbCritical, TitreMsg: Exit Sub
Case Else: If Not IsNumeric(Colonne) Then MsgBox "Type de donnée """ & TypeName(Colonne) & _
""" non supporté comme spécification de colonne.", vbCritical, TitreMsg: Exit Sub
End Select
End Sub
Public Sub CAM_Change(ByVal CAM As CAsso)
If NePasExécuterChange Then Exit Sub
RaiseEvent Change(CAM)
' Si l'UserForm utilise un ComboBoxLiées nommé CLs, Conseil: CLs.UnContrôleAChangé (Pour détection CLs.ChangéÀLEchap)
End Sub
Public Sub CAM_KeyDown(ByVal CAM As CAsso, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
RaiseEvent KeyDown(CAM, KeyCode, Shift)
' Si l'UserForm utilise un ComboBoxLiées nommé CLs, Conseil: CLs.ToucheAppuyée KeyCode (Pour détection CLs.ChangéÀLEchap)
End Sub
Public Sub CAM_KeyPress(ByVal CAM As CAsso, ByVal KeyAscii As MSForms.ReturnInteger)
NePasExécuterChange = True
RaiseEvent KeyPress(CAM, KeyAscii)
NePasExécuterChange = False
End Sub
Public Sub CAM_KeyUp(ByVal CAM As CAsso, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
RaiseEvent KeyUp(CAM, KeyCode, Shift)
End Sub
