[Résolu] Formulaire présentant les divers macros vba excel

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
    Rows(Target.Row).Copy Destination:=Feuil2.Range("A1")
End If
End Sub

Private Sub Categories_Change()
Workbooks("Codes.xls").Sheets("DATA").Cells(2, 5).Value = Me.Categories.Value
Application.Run "Codes.xls!MAJ"
Me.ListBox1.RowSource = "Rubrique"
End Sub

Option Explicit
Private Declare Function FindWindow& Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function SetWindowLong& Lib "User32" Alias "SetWindowLongA" _
(ByVal Hwnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function ShowWindow& Lib "User32" _
(ByVal Hwnd&, ByVal nCmdShow&)

Dim Tableau(), temp, TabTemp As Variant, lig%, n&, Hwnd&
    
Private Sub Categories_Change()
If Me.Categories.Value = "" Then Exit Sub
 
  With Me.Rubriques
    .ListItems.Clear
    
    For lig = 1 To UBound(TabTemp, 1)
      If TabTemp(lig, 3) = Me.Categories.Value Then
        .ListItems.Add , , TabTemp(lig, 1)
        n = .ListItems.Count
        .ListItems(n).ListSubItems.Add , , TabTemp(lig, 2)
        n = n + 1
      End If
    Next
  End With
End Sub

Private Sub Classeur_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim Classeur$
Classeur = ThisWorkbook.Path & "\Codes" & "\Codes.xls"

Set wb = Workbooks.Open(Classeur)
Set ws = wb.Worksheets("Data")
ShowWindow Hwnd, 2

End Sub

Private Sub UserForm_Initialize()
Dim i%, j%, k%, derlig&, Cpt
  
Sheets("Data").Activate
Cpt = Application.CountA(Range("A2:A65536")) - Application.CountIf(Range("A2:A65536"), "*part*")
   
    With ThisWorkbook.Worksheets("Data")
      derlig = .Range("A65535").End(xlUp).Row
      TabTemp = .Range(.Cells(2, 1), .Cells(derlig, 3)).Value
    End With

   
   
   With Me.Rubriques
   With .ColumnHeaders: .Add , , "RUBRIQUES", 250: End With
      For i = 2 To Worksheets("Data").Cells(65536, 1).End(xlUp).Row
        .ListItems.Add , , Worksheets("Data").Cells(i, 1).Value
        .ListItems(.ListItems.Count).Tag = i  'Le numréro de la ligne
      Next i
      Me.Nombre.Caption = Cpt & " Codes VBA-Excel"
 End With
    
ReDim Tableau(200)
For i = 2 To 200
Tableau(i) = Cells(i + 1, 3)
Next

For i = 1 To (UBound(Tableau) - 1)
For k = i + 1 To UBound(Tableau) - 1
If Tableau(i) > Tableau(k) Then
temp = Tableau(i)
Tableau(i) = Tableau(k)
Tableau(k) = temp
End If
Next
Next

For k = 1 To (UBound(Tableau) - 1)
If Tableau(k) = Tableau(k + 1) Then
Else
Me.Categories.AddItem Tableau(k)
End If
Next
 
 Hwnd = FindWindow(vbNullString, Me.Caption)
 
  Dim Fichier As String
    Dim X As Long
    
    Fichier = ThisWorkbook.Path & "\vba.ico"
    X = Len(Dir(Fichier))
    If X = 0 Then Exit Sub
    
    X = ExtractIconA(0, Fichier, 0)
    SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, X
End Sub

Private Sub UserForm_Activate()
ShowWindow Hwnd, 0
SetWindowLong Hwnd, -20, &H40101
ShowWindow Hwnd, 1
End Sub

Private Sub Rubriques_Click()
Dim c As Integer
Application.ScreenUpdating = False

For c = 1 To Rubriques.ListItems.Count
If Me.Rubriques.SelectedItem.Text <> "" Then
Me.Lbl_Rubriques.Caption = Me.Rubriques.SelectedItem.Text
Me.Codes.Text = Worksheets("Data").Cells(Me.Rubriques.SelectedItem.Tag, 2).Text
End If
Next c


Application.ScreenUpdating = True
End Sub


Private Sub Copier_Click()
With Me.Codes
    .SetFocus
    .SelStart = 0
    .SelLength = Len(Me.Codes.Value)
    .Copy
End With
End Sub

Private Sub Fermer_Click()
Unload Me
End Sub