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
|
Private Sub Workbook_Open()
On Error Resume Next
' On créé un onglet par véhicule s'il n'existe pas déjà
Colonne = 3
Ligne = 3
While Not IsEmpty(Worksheets("DATA").Cells(Ligne, Colonne))
If Not IsWorksheet(Worksheets("DATA").Cells(Ligne, Colonne)) Then
Worksheets("PLANNING").Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Worksheets("DATA").Cells(Ligne, Colonne)
End If
Ligne = Ligne + 1
Wend
' On efface tous les boutons
Worksheets("MENU").DrawingObjects.Delete
' On créé dynamiquement un bouton par véhicule
Colonne = 3
Ligne = 3
CompteurGauche = 0
CompteurHaut = 0
While Not IsEmpty(Worksheets("DATA").Cells(Ligne, Colonne))
Set Obj = Worksheets("MENU").OLEObjects.Add("Forms.CommandButton.1")
With Obj
.Left = 50 + (CompteurGauche * .Width * 3)
.Top = 50 + (CompteurHaut * .Height * 3)
.Width = 150
.Height = 40
.Object.Caption = Worksheets("DATA").Cells(Ligne, Colonne - 1) + vbCrLf + Worksheets("DATA").Cells(Ligne, Colonne)
NbJour = DateDiff("d", Now, Worksheets("DATA").Cells(Ligne, Colonne + 1))
If NbJour <= Worksheets("DATA").Cells(3, 6) Then
.Object.BackColor = RGB(255, 122, 122)
End If
End With
laMacro = "Sub CommandButton" + CStr(Ligne - 2) + "_Click()" & vbCrLf
laMacro = laMacro & "Worksheets(" + """" + Worksheets("DATA").Cells(Ligne, Colonne) + """" + ").Activate" & vbCrLf
laMacro = laMacro & "End Sub"
'MsgBox laMacro
With ThisWorkbook.VBProject.VBComponents("MENU").CodeModule
x = .CountOfLines + 1
.InsertLines x, laMacro
End With
CompteurGauche = CompteurGauche + 1
If CompteurGauche > 4 Then
CompteurGauche = 0
CompteurHaut = CompteurHaut + 1
End If
Ligne = Ligne + 1
Wend
' On se positionne sur l'onglet "MENU"
Worksheets("MENU").Activate
End Sub |
Partager