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
| Sub LierCellulesAccess()
' Déclaration des variables
Dim cn As Object
Dim rs As Object
Dim strConnexion As String
Dim strSQL As String
Dim ws As Worksheet
Dim cellule1 As Range, cellule2 As Range, cellule3 As Range, cellule4 As Range, cellule5 As Range, cellule6 As Range, cellule7 As Range, cellule8 As Range, cellule9 As Range
Dim i As Integer ' Compteur pour les répétitions
Dim j As Integer ' Compteur pour le nombre total de lignes traitées
' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("Planning annuel")
' Définir les cellules que vous souhaitez lier
Set cellule1 = ws.Range("V4")
Set cellule2 = ws.Range("V1")
Set cellule3 = ws.Range("V2")
Set cellule4 = ws.Range("V4")
Set cellule5 = ws.Range("B8")
Set cellule6 = ws.Range("B10")
Set cellule7 = ws.Range("B8")
Set cellule8 = ws.Range("C10")
Set cellule9 = ws.Range("A10")
strConnexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Users\xxxxxxxxxxxxxx\Documents\gestion-rendezvous\Gestion.accdb"
Set cn = CreateObject("ADODB.Connection")
cn.Open strConnexion
Set rs = CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM T_RendezVous" ' Modifiez en fonction de votre table
rs.Open strSQL, cn, adOpenStatic, adLockOptimistic ' Ouverture du recordset pour pouvoir ajouter des enregistrements
i = 0
j = 0
' Boucle pour ajouter des enregistrements jusqu'à 1003 lignes traitées
Do While j < 1003
rs.AddNew
On Error Resume Next
' Remplissage des champs de la base de données avec les valeurs des cellules
rs.Fields("Objet").Value = cellule1.Value
rs.Fields("Emplacement").Value = cellule2.Value
rs.Fields("Note").Value = cellule3.Value
rs.Fields("Categorie").Value = cellule4.Value
rs.Fields("DateDebut").Value = cellule5.Value
rs.Fields("HeureDebut").Value = cellule6.Value
rs.Fields("DateFin").Value = cellule7.Value
rs.Fields("HeureFin").Value = cellule8.Value
rs.Fields("IdCalendrierOutlook").Value = cellule9.Value
rs.Update
' Déplacement des cellules de manière cyclique
i = i + 1
j = j + 1
If i Mod 7 = 0 Then
Set cellule1 = cellule1 ' Reste fixe
Set cellule2 = cellule2 ' Reste fixe
Set cellule3 = cellule3 ' Reste fixe
Set cellule4 = cellule4 ' Reste fixe
Set cellule5 = cellule5.Offset(0, -6)
Set cellule6 = cellule6.Offset(0, -11)
Set cellule7 = cellule7.Offset(0, -6)
Set cellule8 = cellule8.Offset(0, -11)
Set cellule9 = cellule9 ' Reste fixe
Else
Set cellule1 = cellule1 ' Reste fixe
Set cellule2 = cellule2 ' Reste fixe
Set cellule3 = cellule3 ' Reste fixe
Set cellule4 = cellule4 ' Reste fixe
Set cellule5 = cellule5.Offset(0, 1)
Set cellule6 = cellule6.Offset(0, 2)
Set cellule7 = cellule7.Offset(0, 1)
Set cellule8 = cellule8.Offset(0, 2)
Set cellule9 = cellule9 ' Reste fixe
End If
' Passer à la ligne suivante toutes les 15 lignes et sauter 5 lignes
If j Mod 15 = 0 Then
Set cellule1 = cellule1.Offset(20, 0) ' Sauter 5 lignes après 15 lignes (donc 20 lignes au total)
Set cellule2 = cellule2.Offset(20, 0)
Set cellule3 = cellule3.Offset(20, 0)
Set cellule4 = cellule4.Offset(20, 0)
Set cellule5 = cellule5.Offset(20, -i + 1) ' Revenir à la première colonne et sauter 5 lignes
Set cellule6 = cellule6.Offset(20, -2 * (i - 1))
Set cellule7 = cellule7.Offset(20, -i + 1)
Set cellule8 = cellule8.Offset(20, -2 * (i - 1))
Set cellule9 = cellule9.Offset(20, 0)
i = 0
End If
Loop
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub |
