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