Discussion :

[samchich]

Bonjour
mon planning:

je souhaite stocker des données de mon planning dans Access avec ce bout de code
je ne parvient pas a faire des boucles correct merci pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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