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

Sub Copie()
With UserForm1.TextBox1
    .SetFocus
    .SelStart = 0
    .SelLength = Len(UserForm1.TextBox1.Value)
    .Copy
End With
End Sub

Option Explicit
 
Private Declare Function FindWindowA& Lib "User32" _
    (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" _
    (ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" _
    (ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" _
    (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)

Private Sub UserForm_Initialize()
  Dim i, Cpt
  Sheets("Data").Activate

'Evite de comptabiliser les macros qui contiennent le mot (suite), sinon 109 au lieu de 100 est affiché
Cpt = Application.CountA(Range("A2:A65536")) - Application.CountIf(Range("A2:A65536"), "*suite*")
  


   With Me.ListView1
      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
        .HideColumnHeaders = True
        .ColumnHeaders.Add , , , 185, lvwColumnLeft
      Next i
      Me.Nbr.Caption = Cpt & " Codes VBA-Excel"
 End With
 
  Dim hWnd As Long
    
    hWnd = FindWindowA(vbNullString, Me.Caption)
    SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
 
 
  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()

  Dim hWnd As Long
    
    hWnd = FindWindowA("XLMAIN", Application.Caption)
    EnableWindow hWnd, 1
End Sub

Private Sub ListView1_AfterUpdate()
Call tri
End Sub


Private Sub ListView1_Click()
Application.ScreenUpdating = False
Me.Label1.Caption = Me.ListView1.SelectedItem.Text
Me.TextBox1.Value = Worksheets("Data").Cells(Me.ListView1.SelectedItem.Tag, 2).Text
Me.TextBox1.SetFocus
Application.ScreenUpdating = True
End Sub

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

Private Sub Imprimer_Click()
  Dim DWord As Object, Fichier$, c
  Fichier = ThisWorkbook.Path & "\Codes-Docs\" & Me.Label1.Caption & ".doc"
  Set DWord = New Word.Application
  For c = 1 To 1
  DWord.Documents.Add
  DWord.Selection.TypeText Me.TextBox1.Text
  DWord.ActiveDocument.SaveAs Fichier
  DWord.ActiveDocument.Close
  Set DWord = Nothing
  Next c
End Sub

Private Sub Fermer_Click()
Unload Me
End Sub

Sub tri()
Sheets("Data").Activate
Range("A1:B65536").Select 
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
Range("A1").Select
End Sub