Coloriage de boutons au survol

La couleur du texte du bouton survolé est modifiée.

FormMouseMove
FormClick

Dim Btn(1 To 10) As New ClasseBoutons
Private Sub UserForm_Initialize()
  For i = 1 To 8
     Set Btn(i).GrBoutons = Me("commandbutton" & i)
  Next i
End Sub

Module de classe

Public WithEvents GrBoutons As Msforms.CommandButton
Private Sub GrBoutons_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  For i = 1 To 8:
     UserForm1("CommandButton" & i).ForeColor = 0
     UserForm1("CommandButton" & i).Font.Bold = False
  Next
  GrBoutons.ForeColor = RGB(255, 0, 0)
  GrBoutons.Font.Bold = True
End Sub

Private Sub GrBoutons_click()
   MsgBox GrBoutons.Name
End Sub

Coloriage de labels au survol

FormMouseMoveLabel
FormMouseMoveLabel2

Dim Lbl(1 To 4) As New ClasseLabels
Private Sub UserForm_Initialize()
  For i = 1 To 4
     Set Lbl(i).GrLabels = Me("Label" & i)
  Next i
End Sub

Module de classe ClasseLabels

Public WithEvents GrLabels As Msforms.Label
Private Sub Grlabels_MouseMove(ByVal Lbl As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  For i = 1 To 4
     GrLabels.Parent("Label" & i).BackColor = 0
  Next
  GrLabels.BackColor = RGB(255, 0, 0)
End Sub

Positionnement bouton effacement

Form position bouton

Dim Txt(1 To 12) As New ClasseSaisie
Private Sub UserForm_Initialize()
   For b = 1 To 12: Set Txt(b).GrSaisie = Me("textbox" & b): Next b
End Sub

Private Sub B_efface_Click()
  temp = Me.B_efface.Tag
  Me(temp) = ""
  Me(temp).SetFocus
End Sub

Module de classe

Public WithEvents GrSaisie As MSForms.TextBox
Private Sub GrSaisie_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   temp = GrSaisie.Name
   UserForm1.B_efface.Top = UserForm1(temp).Top
   UserForm1.B_efface.Tag = temp
End Sub

Changement de zone automatique si 3 caractères saisis

FormSaisie3Caractères

Module de classe:
Public WithEvents GrSaisie As MSForms.TextBox
Private Sub GrSaisie_Change()
  If Len(GrSaisie.Value) = 3 Then
    temp = GrSaisie.Name
    Position = ""
    For i = 1 To Len(temp)
      If IsNumeric(Mid(temp, i, 1)) Then Position = Position & Mid(temp, i, 1)
    Next i
    If Val(Position) = 12 Then Position = 0
       UserForm1("textbox" & Position + 1).SetFocus
    End If
End Sub

Formulaire:

Dim Txt(1 To 12) As New ClasseSaisie
Private Sub UserForm_Initialize()
For b = 1 To 12: Set Txt(b).GrSaisie = Me("textbox" & b): Next b
End Sub

Création de checkBox

Permet de cacher les colonnes cochéés.

FormCréeChekBox

Module de classe nommé classeSaisie

Public WithEvents GrSaisie As MSForms.CheckBox
Private Sub GrSaisie_Change()
nomcheck = GrSaisie.Name
col = Val(Mid(GrSaisie.Name, 9))
Columns(col).Hidden = UserForm1.Controls(nomcheck).Value
End Sub

Formulaire

Dim n
  Dim Chk(1 To 100) As New ClasseSaisie
  Private Sub UserForm_Initialize()
    n = 26
    For b = 1 To n
      retour = Me.Controls.Add("Forms.Label.1", "Label" & b, True)
      Me("Label" & b).Caption = Split(Cells(1, b).Address, "$")(1)
      Me("Label" & b).Top = 50
      Me("Label" & b).Left = 12 + (b - 1) * 12

      retour = Me.Controls.Add("Forms.Checkbox.1", "CheckBox" & b, True)
      Me("CheckBox" & b).Top = 60
      Me("CheckBox" & b).Left = 10 + (b - 1) * 12
    Next
    '--
    For b = 1 To n: Set Chk(b).GrSaisie = Me("Checkbox" & b): Next b
End Sub

Private Sub b_result_Click()
  For b = 1 To n
    On Error Resume Next
    If Me("CheckBox" & b) Then MsgBox b
  Next
End Sub

Private Sub B_sup_Click()
  For b = 1 To n
    On Error Resume Next
    Me.Controls.Remove "Checkox" & b
  Next
End Sub

Saisie limitée à 5 options

FormCheckBox

Dim Chk(1 To 24) As New ClasseSaisie
Private Sub UserForm_Initialize()
  For b = 1 To 24: Set Chk(b).GrSaisie = Me("Checkbox" & b): Next b
  Me.b_ok.Enabled = False
End Sub

Private Sub b_ok_Click()
  ligne = 8
  For i = 1 To 24
     If Me("checkbox" & i) Then
       Cells(ligne, 6) = Me("checkbox" & i).Caption
       ligne = ligne + 1
     End If
  Next i
End Sub

Module de classe ClasseSaisie:

Public WithEvents GrSaisie As MSForms.CheckBox
   Private Sub GrSaisie_Change()
   n = 0
   For i = 1 To 24
     If Selection_titres("Checkbox" & i) Then n = n + 1
   Next i
   Selection_titres.TextBox1.Value = n
   If n > 5 Then Selection_titres(GrSaisie.Name) = False
   Selection_titres.b_ok.Enabled = IIf(n > 0, True, False)
End Sub