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 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
|
Option Explicit
Option Base 1
Dim fl As Worksheet
Private Sub lbxgrille_Click()
Call sup_bouton 'ici je veux supprimer les labels
Set fl = Worksheets(lbxgrille.Value)
Call affichage
End Sub
Private Sub UserForm_Initialize()
Dim fl As Worksheet
For Each fl In Worksheets
If Left(fl.Name, 9) = "grille du" Then
lbxgrille.AddItem fl.Name
End If
Next
End Sub
Sub affichage()
Dim nbcol
Dim nbligne
Dim lab() As Control
Dim tabaff()
Dim i As Integer
Dim j As Integer
nbligne = fl.Cells(65536, 1).End(xlUp).Row
nbcol = fl.Cells(1, 256).End(xlToLeft).Column
ReDim tabaff(nbligne, nbcol)
ReDim lab(nbligne * nbcol)
For i = LBound(tabaff, 1) To UBound(tabaff, 1) 'boucle sur les col
For j = LBound(tabaff, 2) To UBound(tabaff, 2) 'boucle sur les lignes
If i = 1 And j > 2 And j < UBound(tabaff, 2) Then 'prenom en 4 lettre
tabaff(i, j) = Left(fl.Cells(i, j).Value, 4)
Else: tabaff(i, j) = fl.Cells(i, j).Value
End If
Next j
Next i
For i = LBound(tabaff, 1) To UBound(tabaff, 1) 'contenu des ligne
For j = LBound(tabaff, 2) To UBound(tabaff, 2) ' contenu des col
Set lab(j) = vudesgrilles.Controls.Add("forms.label.1")
With lab(j)
.Height = 12
If j < 3 Then
.Left = 5 + (j - 1) * 70
.Width = 70
Else
.Left = 5 + (j - 1) * 30 + 80
.Width = 25
End If
.top = 25 + i * 18
.Font.Size = 8
.Caption = tabaff(i, j)
.TextAlign = fmTextAlignLeft
End With
Next j
Next i
Set fl = Nothing
End Sub
Sub sup_bouton()
Dim lab As Label
For Each lab In grlabel
lab.Delete
Next lab
End Sub |
Partager