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
|
Private Sub TransferButton_Click()
Dim ConcatenationPremAnnee As String
Dim ConcatenationSecAnnee As String
Dim Row As Long
Dim RowM2 As Long
'Dim compteur As Single
'Dim progression As Integer
Dim c As Range
Dim cExt As Range
Dim cDD As Range
Dim Info As String
Application.ScreenUpdating = True
UserForm1.Height = 210
Label1.Visible = False
'compteur = 0
'progression = 0
'Gestion des cellules contenant "3A Ext" et se rapportant à "M2"
If CheckBox1.Value = -1 Then
For Each c In Worksheets("Parcours").Columns(7).Cells.Find("M2")
For Each cExt In Worksheets("Parcours").Columns(8).Cells.Find("3A Ext")
Do
Row = 396
'Chaînes des colonnes K-O et U-Y concaténées
With ThisWorkbook.Worksheets("Parcours")
ConcatenationPremAnnee = .Cells(Row, 11) + .Cells(Row, 12) + .Cells(Row, 13) + .Cells(Row, 14) + .Cells(Row, 15)
ConcatenationSecAnnee = .Cells(Row, 21) + .Cells(Row, 22) + .Cells(Row, 23) + .Cells(Row, 24) + .Cells(Row, 25)
End With
For RowMI2 = 10 To 1075
'Transfert des données de la feuille Parcours à la feuille MI2
Worksheets("M2").Cells(RowM2, 1) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 1)
Worksheets("M2").Cells(RowM2, 2) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 2)
Worksheets("M2").Cells(RowM2, 3) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 3)
Worksheets("M2").Cells(RowM2, 4) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 4)
Worksheets("M2").Cells(RowM2, "E").Value = "S9"
Worksheets("M2").Cells(RowM2, "F") = ConcatenationPremAnnee
Worksheets("M2").Cells(RowM2, "K").Value = "S10"
Worksheets("M2").Cells(RowM2, "L") = ConcatenationSecAnnee
'Incrémentation du numéro de ligne de la feuille Parcours
Row = Row + 1
Next RowM2
Loop Until Row = 1461
NbExt = Worksheets("Parcours").Columns(8).Cells.Find("3A Ext").Count
Next cExt
Next c
End If
'Gestion des cellules contenant "3A DD" et se rapportant à "M2"
If CheckBox2.Value = -1 Then
For Each cDD In Worksheets("Parcours").Columns(8).Cells.Find("3A DD")
Do
Row = 396
'Chaînes des colonnes K-O et U-Y concaténées
With ThisWorkbook.Worksheets("Parcours")
ConcatenationPremAnnee = .Cells(Row, 11) + .Cells(Row, 12) + .Cells(Row, 13) + .Cells(Row, 14) + .Cells(Row, 15)
ConcatenationSecAnnee = .Cells(Row, 21) + .Cells(Row, 22) + .Cells(Row, 23) + .Cells(Row, 24) + .Cells(Row, 25)
End With
For RowM2 = 10 To 1075
'Transfert des données de la feuille Parcours à la feuille MI2
Worksheets("M2").Cells(RowM2, 1) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 1)
Worksheets("M2").Cells(RowM2, 2) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 2)
Worksheets("M2").Cells(RowM2, 3) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 3)
Worksheets("M2").Cells(RowM2, 4) = ThisWorkbook.Worksheets("Parcours").Cells(Row, 4)
Worksheets("M2").Cells(RowM2, "E").Value = "S9"
Worksheets("M2").Cells(RowM2, "F") = ConcatenationPremAnnee
Worksheets("M2").Cells(RowM2, "K").Value = "S10"
Worksheets("M2").Cells(RowM2, "L") = ConcatenationSecAnnee
'Incrémentation du numéro de ligne de la feuille Parcours
Row = Row + 1
Next RowM2
Loop Until Row = 1461
NbDD = Worksheets("Parcours").Columns(8).Cells.Find("3A DD").Rows.Count
Next cDD
End If
'Obtention d'un message si aucune case n'est cochée
If CheckBox1.Value = 0 And CheckBox2.Value = 0 And CheckBox3.Value = 0 And CheckBox4.Value = 0 And CheckBox5.Value = 0 And CheckBox6.Value = 0 And CheckBox7.Value = 0 And CheckBox8.Value = 0 Then
Info = MsgBox("Veuillez cocher au moins une case", vbInformation + vbOKOnly, "Information")
End If
'Centieme = NbTotal / 100
'Millieme = NbTotal / 1000
'Code de la barre de progression
'compteur = compteur + Millieme
'If compteur Mod Centieme = 0 Then 'Condition exécutée 100 fois
'progression = progression + 1
'Image_barre.Width = progression * 1.5
'Label_barre.Caption = progression & " %"
'DoEvents
'End If
'Application.ScreenUpdating = True
Label1.Visible = True
End Sub |
Partager