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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
| Private Sub UserForm_Initialize()
End Sub
Private Sub CdB_Ok_Click()
Dim nb_column1 As Long, nb_column2 As Long, New_WS As String
nb_column1 = Worksheets("Employees List").UsedRange.Columns.Count
nb_column2 = Worksheets("Training Hours").UsedRange.Columns.Count
Application.ScreenUpdating = False
'Activate "Training List" sheet
With Worksheets("Training List").Activate
ActiveSheet.Unprotect
'Insert row under copied row
Rows("10:12").Select
Selection.EntireRow.Hidden = False
Rows("11:11").Select
Selection.Copy
Rows("12:12").Select
Selection.Insert Shift:=xlDown
Range("B12").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = TxtBox_Training.Value
End With
'Add a new tab
Sheets("--Template--").Select 'Sélection de l'onglet "Template"
Sheets("--Template--").Copy After:=Sheets(5)
Sheets("--Template-- (2)").Select
Sheets("--Template-- (2)").Name = TxtBox_Training.Value
Range("B1") = TxtBox_Training.Value
Range("B1").Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.ListObjects("").Name = Range("B1").Value
'Activate "Training List" sheet
With Worksheets("Training List").Activate
New_WS = TxtBox_Training.Value
'Hide reference row
Rows("11:11").Select
Selection.EntireRow.Hidden = True
'Replace tab address in formulas
Range("G12:I12").Select
Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Replace table's name in formulas
Range("H12").Select
Selection.Replace What:="Template", Replacement:=Worksheets(New_WS).Range("B1").Value, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Add hypertext link of new tab
Range("B12").Select
xxx = TxtBox_Training.Value
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
xxx & "!Print_Area", TextToDisplay:=xxx
'Sort training list A to Z
ActiveWorkbook.Worksheets("Training List").AutoFilter.Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Training List").AutoFilter.Sort.SortFields. _
Add Key:=Range("B10"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Training List").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Protect sheet
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowSorting:=True, AllowFiltering:=True
End With
'Activate "Employees List" sheet
With Worksheets("Employees List").Activate
ActiveSheet.Unprotect
'Unhide hidden column
Columns("G:K").Select
Selection.EntireColumn.Hidden = False
'Copy of reference column
Columns("H:J").Select
Selection.Copy
'Insert at the end of table a new column
Columns(nb_column1 + 1).Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
'Replace "--Template--" by the tab's name
Columns(nb_column1 + 1).Select
Selection.Replace What:="--Template--2", Replacement:=TxtBox_Training.Value, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns(nb_column1 + 2).Select
Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Year3", Replacement:="Year", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.EntireColumn.Hidden = True
Columns(nb_column1 + 3).Select
Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Hours4", Replacement:="Hours", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.EntireColumn.Hidden = True
'Hide reference column
Columns("H:J").Select
Selection.EntireColumn.Hidden = True
'Protect sheet
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:= _
True
End With
'Activate "Training Hours" sheet
With Worksheets("Training Hours").Activate
'Unhide hidden column
Columns("E:G").Select
Selection.EntireColumn.Hidden = False
'Copy of reference column
Columns("F:F").Select
Selection.Copy
'Insert at the end of table a new column
Columns(nb_column2 + 1).Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
'Replace "--Template--" by the tab's name
Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Hide reference column
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
End With
'Close userform
Unload Me
Worksheets("Training List").Select
End Sub
Private Sub CdB_Cancel_Click()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub |
