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
| Option Explicit
Private Sub Btn_Feries_Click()
Liaisons_Dossier_Onglet_Divers.Bouton_Data_Feries
End Sub
Private Sub TextBoxDuree_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Autorise la saisie de certains caractères
Select Case KeyAscii
Case 48 To 57 'Accepte de 0 à 9
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub LabelDateDebut_Click()
USF_Calendar_Travaux_Debut.Show
End Sub
Private Sub LabelJourSemDebut_Click()
USF_Calendar_Travaux_Debut.Show
End Sub
Private Sub LabelDateFin_Click()
USF_Calendar_Travaux_Fin.Show
End Sub
Private Sub LabelJourSemFin_Click()
USF_Calendar_Travaux_Fin.Show
End Sub
Private Sub TextBoxDuree_Change()
Dim Start_Date As Date, DateDebut As Date, DateFin As Date, Days As Long, Week As String, Holydays As Range, Date_debut As Variant
'Calcul de la date de fin si la date de début existe
On Error GoTo Fin 'Si les dates sont vides
Start_Date = LabelDateDebut
If TextBoxDuree = "" Then
LabelDateFin = LabelDateDebut
LabelJourSemDebut = Format(LabelDateDebut, "ddd") 'Afficher le jour de la semaine devant la date
LabelJourSemFin = Format(LabelDateFin, "ddd") 'Afficher le jour de la semaine devant la date
Else
Days = TextBoxDuree 'nombre de jour
Week = "0000011"
Set Holydays = Range("Tableau_Fériés[Jours fériés et ponts]") 'Vérifier les dates dans le tableau de la feuille DATA
DateFin = CDate(Application.WorkDay_Intl(Start_Date, Days, Week, Holydays))
LabelDateFin = DateFin
LabelJourSemDebut = Format(LabelDateDebut, "ddd") 'Afficher le jour de la semaine devant la date
LabelJourSemFin = Format(LabelDateFin, "ddd") 'Afficher le jour de la semaine devant la date
End If 'Fin du calcul de la date de fin si la date de début existe
Fin:
End Sub
Private Sub UserForm_Initialize()
Dim ID_CFC As Variant
Dim Trouve As Range
Dim PlageDeRecherche As Range
Dim Valeur_Cherchee As String
Dim AdresseTrouvee As String
Application.ScreenUpdating = False
ID_CFC = ActiveCell.Offset(rowOffset:=0, columnOffset:=-2).Value & "-10001"
'Rechercher et sélectionner la cellule contenant ID_
Set PlageDeRecherche = ActiveSheet.Columns(1)
Set Trouve = PlageDeRecherche.Cells.Find(what:=ID_CFC, LookAt:=xlWhole) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
'ici, traitement pour le cas où la valeur n'est pas trouvée
AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
'ici, traitement pour le cas où la valeur est trouvée
AdresseTrouvee = Trouve.Address
LabelCFC.Caption = Range(AdresseTrouvee).Offset(rowOffset:=0, columnOffset:=12)
End If
Me.TextBoxPVchantier.SetFocus 'Place le curseur dans la textbox
FrameDate.Caption = "Nous sommes le " & Format(Now, "dddd dd.mm.yyyy")
TextBoxPVchantier = ActiveCell.Value
LabelDateDebut = ActiveCell.Offset(rowOffset:=0, columnOffset:=2) 'Charger avant la TextBoxDuree sinon la macro plante car la date et vide
LabelDateFin = ActiveCell.Offset(rowOffset:=0, columnOffset:=3) 'Charger avant la TextBoxDuree sinon la macro plante car la date et vide
TextBoxDuree = ActiveCell.Offset(rowOffset:=0, columnOffset:=1)
LabelJourSemDebut = Format(LabelDateDebut, "ddd") 'Afficher le jour de la semaine devant la date
LabelJourSemFin = Format(LabelDateFin, "ddd") 'Afficher le jour de la semaine devant la date
If ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "Impératif" Then
Option_Imperatif = True
End If
If ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "En cours" Then
Option_En_cours = True
End If
If ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "En retard" Then
Option_En_retard = True
End If
If ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "Urgent" Then
Option_Urgent = True
End If
If ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "Terminé" Then
Option_Terminé = True
End If
If ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "" Then
Option_blanc = True
End If
End Sub
Private Sub BT_Annuler_Click()
Unload Me
End Sub
Private Sub BT_OK_Click()
Dim Date_début As Date
Dim Date_Fin As Date
ActiveCell = TextBoxPVchantier
ActiveCell.Offset(rowOffset:=0, columnOffset:=1) = TextBoxDuree.Value
ActiveCell.Offset(rowOffset:=0, columnOffset:=6) = Now
If LabelDateDebut = "" Then
'Pas de date
Else
Date_début = LabelDateDebut
ActiveCell.Offset(rowOffset:=0, columnOffset:=2) = Date_début 'Variable obligatoire pour avoir la date au format date dans excel
End If
If LabelDateFin = "" Then
'Pas de date
Else
Date_Fin = LabelDateFin
ActiveCell.Offset(rowOffset:=0, columnOffset:=3) = Date_Fin 'Variable obligatoire pour avoir la date au format date dans excel
End If
'Avancement du chantier
If Option_Imperatif.Value = True Then 'Si coché ...
ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "Impératif"
End If
If Option_En_cours.Value = True Then 'Si coché ...
ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "En cours"
End If
If Option_En_retard.Value = True Then 'Si coché ...
ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "En retard"
End If
If Option_Urgent.Value = True Then 'Si coché ...
ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "Urgent"
End If
If Option_Terminé.Value = True Then 'Si coché ...
ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = "Terminé"
End If
If Option_blanc.Value = True Then 'Si coché ...
ActiveCell.Offset(rowOffset:=0, columnOffset:=4) = ""
End If
ActiveCell.Cells.CheckSpelling SpellLang:=1036 'Lancer le correcteur orthographique
Unload Me
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub |
Partager