Bonjour
je souhaite faire la liaison de ma listview avec une feuil d'un fichier excel volumineuse fermer avec une requête SQL
jusque la tout va bien
je ne parviens pas a ajouter modifier et supprimer dans la feuil excel
si vous avez une solution pour m'aider a adapter ce bout de code merci
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
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
154
155
156
 
Sub Connecte_base()
    Dim rs As Object
    Dim Nom_Base, Chemin_Base, SQL      ', connstring
 
    Set conn = CreateObject("ADODB.Connection")
    Nom_Base = "XXXXXXX.xlsm"
    Chemin_Base = ThisWorkbook.Path & "\" & Nom_Base
    connstring = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & Chemin_Base
    conn.Open connstring
End Sub
 
Sub Recherche_Infos_Affichage_LVW()
    Dim rs As Object
    Dim PartTxt, SQL, SQL1, N, L, C, D, E, NbF
    Set rs = CreateObject("ADODB.recordset")
    PartTxt = TextBox1
    SQL = "select * from [Data$] where [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%' or [XXXXXXX] like '%" & PartTxt & "%'"
    rs.Open SQL, conn, 3, 3
 
 
    If Not rs.EOF Then
        rs.MoveFirst
        NbF = rs.Fields.Count
        NbRecord = rs.RecordCount
        N = 1
        Do While Not rs.EOF
            With ListView1
                .ListItems.Add , , rs.Fields(0)
                For L = 2 To NbF
 
                    .ListItems(N).ListSubItems.Add , , rs.Fields(L - 1)
                Next L
                 If .ListItems(N) = TextBox1 Then .ListItems(N).Bold = True
                If .ListItems(N).ListSubItems(1) < 15 Then
                .ListItems(N).ListSubItems(8).Text = "Alérte Stock"
                    .ListItems(N).Bold = True
                    .ListItems(N).ForeColor = vbGreen
                    For C = 1 To .ColumnHeaders.Count - 1
                        .ListItems(N).ListSubItems(C).Bold = True
                        .ListItems(N).ListSubItems(8).ForeColor = vbGreen     'couleur colonne 7
                    Next C
                    End If
 
                  If .ListItems(N).ListSubItems(1) < 10 Then
                .ListItems(N).ListSubItems(8).Text = "Alérte Commande"
                    .ListItems(N).Bold = True
                    .ListItems(N).ForeColor = vbYellow
                    For D = 1 To .ColumnHeaders.Count - 1
                        .ListItems(N).ListSubItems(D).Bold = True
                        .ListItems(N).ListSubItems(8).ForeColor = vbYellow    'couleur colonne 7
                    Next D
                    End If
 
                   If .ListItems(N).ListSubItems(1) < 5 Then
                .ListItems(N).ListSubItems(8).Text = "Alérte Commande Urgente"
                    .ListItems(N).Bold = True
                    .ListItems(N).ForeColor = vbRed
                    For E = 1 To .ColumnHeaders.Count - 1
                        .ListItems(N).ListSubItems(E).Bold = True
                        .ListItems(N).ListSubItems(8).ForeColor = vbRed     'couleur colonne 8
                    Next E
                End If
            End With
            N = N + 1
            rs.MoveNext
        Loop
        Label2.Caption = NbRecord & " enregistrement(s) !"
    Else
        MsgBox "Attention: pas d'enregistrement trouvé!!"
    End If
    rs.Close
    Set rs = Nothing
 
End Sub
 
Private Sub Ajouter_Click()
    If TextBox3 <> "" Then
        Set rs = CreateObject("ADODB.recordset")
        SQL = "select * from [Data$]where ID=" & CLng(TextBox2) & ";"
        rs.Open SQL, conn, 3, 3
        If Not rs.EOF And Not rs.BOF Then
            rs.AddNew
            rs.Fields(1) = TextBox3
            rs.Fields(2) = TextBox4
            rs.Fields(3) = TextBox5
            rs.Fields(4) = TextBox6
            rs.Fields(5) = TextBox7
            rs.Fields(6) = TextBox8
            rs.Fields(7) = TextBox9
            rs.Fields(8) = TextBox10
            rs.Fields(9) = TextBox11
            rs.Fields(10) = TextBox12
            rs.Update
        End If
        rs.Close
        Set rs = Nothing
        ListView1.ListItems.Clear
        Flg_Boutons = True
        Call Recherche_Infos_Affichage_LVW
        Flg_Boutons = False
    End If
    ThisWorkbook.Save
     MsgBox "Attention: votre enregistrement est Ajouter!!"
End Sub
 
Private Sub Modifier_Click()
Dim PartTxt
    If TextBox3 <> "" Then
        Set rs = CreateObject("ADODB.recordset")
        SQL = "select * from [Data$] where ID=" & CLng(TextBox2) & ";"
        rs.Open SQL, conn, 3, 3
         On Error Resume Next
        If Not rs.EOF And Not rs.BOF Then
            rs.Fields(1) = TextBox3
            rs.Fields(2) = TextBox4
            rs.Fields(3) = TextBox5
            rs.Fields(4) = TextBox6
            rs.Fields(5) = TextBox7
            rs.Fields(6) = TextBox8
            rs.Fields(7) = TextBox9
            rs.Fields(8) = TextBox10
            rs.Fields(9) = TextBox11
            rs.Fields(10) = TextBox12
            rs.Update
        End If
        rs.Close
        Set rs = Nothing
        ListView1.ListItems.Clear
        Flg_Boutons = True
        Call Recherche_Infos_Affichage_LVW
        Flg_Boutons = False
    End If
    ThisWorkbook.Save
     MsgBox "Attention: votre enregistrement est Modifier!!"
End Sub
 
Private Sub Supprimer_Click()
    If TextBox3 <> "" Then
        Set rs = CreateObject("ADODB.Recordset")
        SQL = "select * from [Data$] where ID=" & CLng(TextBox2) & ";"
        rs.Open SQL, conn, 3, 3
        If Not rs.EOF And Not rs.BOF Then
            rs.Delete
            rs.Update
        End If
        rs.Close
        Set rs = Nothing
        ListView1.ListItems.Clear
        Flg_Boutons = True
        Call Recherche_Infos_Affichage_LVW
        Flg_Boutons = False
    End If
    ThisWorkbook.Save
     MsgBox "Attention: votre enregistrement est Supprimer!!"
End Sub