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
|
'*
'* on actualise la base de donnée, soit insertion, soit modification
'*********************************************************************************
Sub creerMajBDD()
' on bloque l'actualisation
Application.ScreenUpdating = False
Dim WsPlanning As Worksheet
Dim WsBddPlanning As Worksheet
Set WsPlanning = Worksheets("planning")
Set WsBddPlanning = Worksheets("BDD_planning")
Dim dateEnCours As Date
Dim ligneEnCours, derniereLigne As Long ' correspondance 1ere et derniere ligne du tableau
Dim premiereColonne, derniereColonne, colonneEnCours As Long ' correspondance 1ere et derniere colonne du tableau ( /!\ attention si mois < 31j trouver concordance /!\ )
Dim premiereLigneBDD, derLigneBDD, indexRecherche As Long ' derniere ligne BDD
Dim trouveDansBDD As Integer ' valeur de test
Dim nom, debut, TypeConges As Variant
Dim idPersonnel As Long ' données à trouver puis récupérer
Dim Tbl()
derniereLigne = WsPlanning.Cells(Rows.Count, 1).End(xlUp).Row ' on rechercher la derniere ligne
premiereColonne = 6 ' jour 1
derniereColonne = WsPlanning.Range("A6").SpecialCells(xlCellTypeLastCell).Column ' on rechercher la derniere colonne en ligne 6, valeur 36 maxi = jour 31
' on parcours les lignes du tableau
' on définit la première ligne à traiter (ligne 1 du tab qui est row=7)
For ligneEnCours = 7 To derniereLigne
idPersonnel = WsPlanning.Cells(ligneEnCours, 5) ' on récupère l'id de la personne
' on parcours les colonnes du tableau
' on définit la première colonne à traiter
For colonneEnCours = premiereColonne To derniereColonne
TypeConges = WsPlanning.Cells(ligneEnCours, colonneEnCours) ' on récupère le type de congés indiqué
' Si un évenement est présent on continu.
If TypeConges <> "" Then
' recherche de la date
dateEnCours = WsPlanning.Cells(5, colonneEnCours) ' on récupère le type de congés indiqué
' Debug.Print idPersonnel & " > date: " & dateEnCours & " | event: " & TypeConges
premiereLigneBDD = 2
derLigneBDD = WsBddPlanning.Cells(Rows.Count, 1).End(xlUp).Row ' on rechercher la derniere ligne
Tbl = WsBddPlanning.Range("A1:C" & derLigneBDD)
trouveDansBDD = -1
' on recherche l'id et la date (date passée en string pour faciliter le travail)
For indexRecherche = premiereLigneBDD To UBound(Tbl)
If Tbl(indexRecherche, 1) = idPersonnel And CStr(Tbl(indexRecherche, 2)) = dateEnCours Then
Debug.Print "Element trouvé : " & idPersonnel & " et " & dateEnCours & " ligne : [" & indexRecherche & "]"
trouveDansBDD = 1
Exit For
End If
Next indexRecherche
Application.EnableEvents = False
'*** Gestion de la donnée trouvée ou non en BDD ***
If trouveDansBDD = -1 Then ' on ajoute la donnée en base
Debug.Print "+++ on ajoute " & idPersonnel & " et " & dateEnCours & " type= " & TypeConges
WsBddPlanning.Cells(derLigneBDD + 1, 1) = idPersonnel
WsBddPlanning.Cells(derLigneBDD + 1, 2) = CStr(dateEnCours)
WsBddPlanning.Cells(derLigneBDD + 1, 3) = TypeConges
ElseIf trouveDansBDD = 1 Then ' on modifie la donnée dans la base
Debug.Print "on modifie " & idPersonnel & " et " & dateEnCours & " type= " & TypeConges
WsBddPlanning.Cells(indexRecherche, 3) = TypeConges
End If
Application.EnableEvents = True
End If
Next colonneEnCours
' fin parcours colonne du tableau
Next ligneEnCours
' fin parcours ligne du tableau
' on réactive l'actualisation
Application.ScreenUpdating = True
WsPlanning.Range("A1").Select
End Sub
'*
'* création du planning fonction de la base de données des personnels sélectionnés
'*********************************************************************************
Sub creerPlanning()
' on bloque l'actualisation
Application.ScreenUpdating = False
Dim WsDestination As Worksheet
Dim bd As Worksheet
Set bd = Worksheets("BDD_planning")
Set WsDestination = Worksheets("planning")
Dim lg As Long, cl As Long
Dim nbligne As Long
Dim nom, debut, TypeConges, idPersonnel As Variant
Dim temp As Object
Dim ligPlan, n, i, d As Long
lg = WsDestination.Cells(Rows.Count, 1).End(xlUp).Row
WsDestination.Range("F7:AJ" & lg).ClearContents
WsDestination.Range("F7:AJ" & lg).ClearFormats
For nbligne = 2 To bd.[C65000].End(xlUp).Row
idPersonnel = bd.Cells(nbligne, 1)
debut = bd.Cells(nbligne, 2)
TypeConges = bd.Cells(nbligne, 3)
Set temp = WsDestination.[E:E].Find(what:=idPersonnel, lookat:=xlWhole)
If Not temp Is Nothing Then
If (Year(debut) = Year(Sheets("Config").Range("B2").Value) And Month(debut) = Month(Sheets("Config").Range("B2").Value)) Then
Application.EnableEvents = False
[couleurs].Find(TypeConges, lookat:=xlWhole).Copy
WsDestination.Cells(temp.Row, Day(debut) + 5) = TypeConges
WsDestination.Cells(temp.Row, Day(debut) + 5).PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
Next nbligne
redimPlanning ' on modifie la taille du tableau pour affichage propre des lignes
' on réactive l'actualisation
Application.ScreenUpdating = True
WsDestination.Range("A1").Select
End Sub |
création planning avec Bdd : question optimisation
Répondre avec citation
, à parcourir le forum il est souvent question de passer par access pour contrer la lenteur d'excel en utilisation bdd
Envoyé par Philippe Tulliez
Partager