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
| Sub Main()
' Déclaration des variables et constantes
Const TableStudent As String = "t_Student" ' Table des étudiants
Const TableUsfPilot As String = "t_Usf" '
Const TemplateName As String = "Template"
Dim rngData As Range ' plage des données
Dim rngCriteria As Range ' plage des critères
Dim rngTarget As Range ' plage d'exportation
Dim wkbTarget As Workbook ' Classeur cible
Dim tbl As Variant
Dim Elem As Byte
' Assignation des variables objets
Set rngData = Range("t_Student").CurrentRegion
Set rngCriteria = Range("areaCriteria")
Set rngTarget = Range("areaTarget")
' Chargement de la table
tbl = Range("t_Classe").Value
' Start
With usfStd
' Changement des propriétés des ChackBox
For Elem = LBound(tbl) To UBound(tbl)
.Controls("CheckBox" & Elem).Caption = tbl(Elem, 1)
Next
' Lancement du UserForm
.Show
' Après Retour par Cancel ou confirmation
If .IsValidated Then
Application.ScreenUpdating = False
For Elem = LBound(tbl) To UBound(tbl)
If .Controls("CheckBox" & Elem).Value Then
rngCriteria.Offset(1).Resize(1).Value = tbl(Elem, 1)
' Exportation des données suivant critères vers la feuille shtTemplate
rngData.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=rngTarget
' Copie de la feuille template vers un nouveau classeur en renommant la feuille
Set wkbTarget = CopySheet(shtTemplate, wkbTarget)
ActiveSheet.Name = tbl(Elem, 1)
End If
Next
End If
End With
Unload usfStd ' fermeture du UserForm
' Fin du programme
Application.ScreenUpdating = True
Set wkbTarget = Nothing: Set rngData = Nothing: Set rngCriteria = Nothing: Set rngTarget = Nothing
End Sub |
