1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
| Private Sub UserForm_activate()
Dim hWnd As Long, exLong As Long, zFactor As Integer
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If exLong And &H880000 Then SetWindowLongA hWnd, -16, exLong And &HFF77FFFF
zFactor = 100 * CInt(Application.Width / Me.Width)
Me.Width = Application.Width
Me.Height = Application.Height
'''''''''''''''''''''''Code pour couleur listview
Dim i&: i = (ListView1.Width * 1 / 3) - 6
hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
With ListView1
.View = lvwReport
.FullRowSelect = True
End With
hFont = CreateFont(13, 0, 0, 0, 700, 0, 0, 0, 0, 0, 0, 0, 0, "Cambria")
OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WinProc)
'==========Définit les entêtes de colonnes==========
With ListView1
With .ColumnHeaders
.Clear 'Supprime les anciens entêtes
'Ajout des colonnes
.Add , , "N°", 30, lvwColumnLeft 'obligatoire alignement a droite premiere colonne
.Add , , "Date", 100, lvwColumnCenter
.Add , , "Equipe 1", 120, lvwColumnCenter
.Add , , "Equipe 2", 120, lvwColumnCenter
.Add , , "Arbitre", 120, lvwColumnCenter
End With
.View = lvwReport 'affichage en mode Rapport
.Gridlines = True 'affichage d'un quadrillage
.FullRowSelect = True 'Sélection des lignes comlètes
'End With
For i = 2 To Sheets("Match").Range("A65536").End(xlUp).Row
.ListItems.Add , , Sheets("Match").Cells(i, 1)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Match").Cells(i, 3) 'Match N°
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Match").Cells(i, 4) 'Date
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Match").Cells(i, 5) 'Equipe1
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Match").Cells(i, 6) 'Equipe2
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Match").Cells(i, 7) 'Arbitre
Next: End With
LB_Classement.ColumnWidths = "120;30;30;30;30"
Me.Label_Classeur.Caption = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) 'affiche le nom du classeur sans l'extention
Me.ListView1.Refresh
End Sub |
