Liaison ListView avec une base excel fermer

Version imprimable

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:

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

19/08/2020, 14h45
Pierre Fauconnier

Salut.

Il me semble que le plus simple serait de rapatrier dans ton classeur les données que tu importes par SQL.

Je n'ai pas compris ce que tu veux dire par "je ne parviens pas a ajouter modifier et supprimer dans la feuil excel"
20/08/2020, 12h33
samchich

1 pièce(s) jointe(s)

Citation:

Envoyé par Pierre Fauconnier

Salut.

Il me semble que le plus simple serait de rapatrier dans ton classeur les données que tu importes par SQL.

Je n'ai pas compris ce que tu veux dire par "je ne parviens pas a ajouter modifier et supprimer dans la feuil excel"

Bonjour et merci
la base et très volumineuse pour cette raison je souhaite la stocker dans un autre ficher
pour la recherche sa maque de rapidité mais sa fonctionne et
pour ajouter modifier et supprimer dans la feuil excel dans ficher fermer j'ai un bug
Cordialement

Pièce jointe 577529
20/08/2020, 13h29
Pierre Fauconnier

Les données qui alimentent le listview ne sauraient pas être volumineuses au point de devoir être stockées ailleurs. Je doute de l'utilité d'un listview de milliers de données, personnellement.

L'idée est donc de rapatrier les données utiles au listview, par exemple par VBA dans une feuille Excel puis d'alimenter le listview sur base de cette feuille Excel.

Cela dit, je n'ai toujours pas compris ce que tu voulais dire par

Citation:

Je ne parviens pas a ajouter modifier et supprimer dans la feuil excel

Si tu veux ajouter des données à tes tables au moyen de ODBC, montre le code que tu utilises pour cela.

1 pièce(s) jointe(s)

Bonjour voici

Code:

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
Private  Sub Ajouter_Click ( ) 
    If TextBox3 <> ""  Then 
        Set rs = CreateObject ( "ADODB.recordset" ) 
        SQL = "select * from [Data $]" 
        rs.Open SQL, Conn, 3 , 3 
        Si  Non rs.EOF Et  pas rs.BOF Puis
            rs.AddNouveau
            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
        Fin  si
        rs.Fermer
        Set rs = Rien
        ListView1.ListItems.Clear
        Flg_Boutons = True 
        Call Recherche_Infos_Affichage_LVW
        Flg_Boutons = Faux 
    Fin  Si
    Ce classeur.
     MsgBox "Attention: votre enregistrement est Ajouter !!" 
End  Sub

j'ai ce message sur la ligne rs.Update
Cordialement
Pièce jointe 577585

21/08/2020, 16h34
Pierre Fauconnier

Ok. Je n'avais pas fait attention à tout ton message. Le code que tu donnes ici est incorrect (mélange d'anglais et de français). Je me suis basé sur ton code initial qui est plus conforme à ce qu'on attend en VBA ;)

Tu ne pourras pas supprimer de lignes dans ta base car le driver adodb pour Excel ne permet pas la suppression. Tu ne peux donc pas utiliser "Delete from MaTable...".

Pour ce qui est de l'ajout ou de la modification, je ne vois rien dans ton code qui empêche rs.update. Commente la ligne On Error Resume Next pour voir si tu n'as pas un souci au niveau d'une des valeurs, mais normalement, le champ n'est tout simplement pas pris en compte si problème à ce niveau, et l'update passe quand même.

As-tu regardé ta base pour voir s'il n'y a pas un problème dedans?