Ecrire de Excel vers SQL ?

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour, merci beaucoup pour votre aides. Une fois de plus je suis obligé d'admettre que je n'ai pas tout compris.

Perso, je ferais des requêtes paramétrées. C'est plus sécurisant et plus facile à écrire qu'une concaténation de chaines.

Je passe par des procédures génériques inscrites dans un module dédié, histoire de ne pas réinventer la roue à chaque fois. J'inclus alors ce module dans tout projet nécessitant des interactions avec une base de données. Ça permet de standardiser le code et l'approche.

concaténation de chaines Vous voulez dire que le "code" pour plusieurs champs dans la même feuilles n'est pas une bonne idée ?

Désolé, je suis largué. Je ne connaissais même pas VBA il y a un mois. J'ai parcouru les forum pour faire ça qui fonctionne bien mais c'est surtout de la présentation.
C'est peut-être même mal "codé"

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
Sub Macro_Programmation()
 
Worksheets("Programmation (Ctrl+R)").Activate
 
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False 'actualiser feuille "Programmation"
 
Range("A2:A1000").Select 'Sélection de la cellule
 
Selection.Interior.Color = RGB(235, 255, 228) 'Arrière-plan de couleur vert
 
Selection.Font.Color = RGB(0, 0, 0) 'Police de couleur noir
 
 
 
 
Range("B2:O1000").Select 'Sélection de la cellule
 
Selection.Interior.Color = RGB(230, 255, 255) 'Arrière-plan de couleur bleu
 
Selection.Font.Color = RGB(0, 0, 0) 'Police de couleur noir
 
 
Range("A2:O1000").Font.Bold = False
Range("A2:O1000").RowHeight = 15
Range("A2:O1000").Font.Size = 11
 
 
 
'changement couleur colonne A Semaine
Dim p As Object 'déclare la variable p (onglet Plannings)
Dim dl As Integer 'décalre la variable dl (Dernière Ligne)
Dim pl As Range 'décalre la variable pl (PLage)
Dim cel As Range 'décalre la variable cel (CELlule)
Dim tl() As Integer 'décalre le tableau de variables indexées tl (Tableau de Lignes)
Dim i As Integer 'décalre la variable i (Incrément)
 
'Set p = Sheets("Programmation (Ctrl+R)") 'définit l'onglet p
'dl = p.Cells(Application.Rows.Count, 1).End(xlUp).Delete 'supprime dernière ligne avec des formules
 
Set p = Sheets("Programmation (Ctrl+R)") 'définit l'onglet p
dl = p.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = p.Range("A2:A" & dl) 'définit la colonne qui est testé
For Each cel In pl 'boucle sur toutes les cellule cel de la plage pl
    If cel.Offset(1, 0).Value <> cel.Value Then 'condition 1 : si la valeur de la cellule en dessous de cel est différente de la valeur de cel
        ReDim Preserve tl(1, i) 'redimensionne le tableau tl
        If tl(0, i) = 0 Then 'condition 2 : si la variable indéxée tl(0,i) est nulle (ligne du début de la plage à colorier)
            tl(0, i) = cel.Offset(1, 0).Row 'récupère le numéro de ligne du début de la plage à colorier
        Else 'sinon
            tl(1, i) = cel.Row 'récupère la ligne de la fin de la plage à colorier
            i = i + 1 'incrémente i
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next cel 'prochaine cellule de la boucle
For i = 0 To UBound(tl, 2) - 1 'boucle sur toutes les variable indexées
    p.Range(p.Cells(tl(0, i), 1), p.Cells(tl(1, i), 1)).Interior.Color = RGB(200, 255, 182)  'colore la plge en vert
Next i 'prochaine variable de la boucle
 
 
 
    'changement couleur colonne B Dossier
    Dim p2 As Object 'déclare la variable p (onglet Plannings)
    Dim dl2 As Integer 'décalre la variable dl (Dernière Ligne)
    Dim pl2 As Range 'décalre la variable pl (PLage)
    Dim cel2 As Range 'décalre la variable cel (CELlule)
    Dim tl2() As Integer 'décalre le tableau de variables indexées tl (Tableau de Lignes)
    Dim i2 As Integer 'décalre la variable i (Incrément)
 
    Set p2 = Sheets("Programmation (Ctrl+R)") 'définit l'onglet p
    dl2 = p2.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
    Set pl2 = p2.Range("B2:B" & dl2) 'définit la colonne qui est testé
    For Each cel2 In pl2 'boucle sur toutes les cellule cel de la plage pl
        If cel2.Offset(1, 0).Value <> cel2.Value Then 'condition 1 : si la valeur de la cellule en dessous de cel est différente de la valeur de cel
         ReDim Preserve tl2(1, i2) 'redimensionne le tableau tl
            If tl2(0, i2) = 0 Then 'condition 2 : si la variable indéxée tl(0,i) est nulle (ligne du début de la plage à colorier)
                tl2(0, i2) = cel2.Offset(1, 0).Row 'récupère le numéro de ligne du début de la plage à colorier
            Else 'sinon
                tl2(1, i2) = cel2.Row 'récupère la ligne de la fin de la plage à colorier
                i2 = i2 + 1 'incrémente i
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next cel2 'prochaine cellule de la boucle
    For i2 = 0 To UBound(tl2, 2) - 1 'boucle sur toutes les variable indexées
        p2.Range(p2.Cells(tl2(0, i2), 2), p2.Cells(tl2(1, i2), 15)).Interior.Color = RGB(182, 254, 255)  'colore la plge en bleu
    Next i2 'prochaine variable de la boucle
 
 
Dim it As Long
Dim Iprec As Long
Dim strNom As String
 
it = 1
'Boucle sur tant que la colonne A n'est pas vide
Do While Range("A" & it).Value <> ""
    'Si nom de la ligne <> du nom precedent
    If strNom <> Range("A" & it).Value Then
        If strNom <> "" Then
            'insere une ligne
            Rows(it).Insert
 
            'Colore la ligne en gris clair
            Rows(it).Interior.Color = RGB(236, 236, 236)
 
            'insere la somme QTE
            'Range("D" & it).FormulaLocal = "=somme(D" & Iprec & ":D" & it - 1 & ")"
            'Range("D" & it).Font.Bold = True
            'Range("D" & it).Font.Size = 16
            'Range("D" & it).VerticalAlignment = xlTop
            'insere la somme TPE
            Range("O" & it).FormulaLocal = "=somme(O" & Iprec & ":O" & it - 1 & ")"
            Range("O" & it).Font.Bold = True
            Range("O" & it).Font.Size = 16
            Range("O" & it).VerticalAlignment = xlTop
            'Ajoute le nom en A
            Range("A" & it).Value = "SEM " + strNom
            Range("A" & it).Font.Bold = True
            Range("A" & it).RowHeight = 40
            Range("A" & it).Font.Size = 16
            Range("A" & it).VerticalAlignment = xlTop
            'mémorise la ligne de début e la prochaine section
            Iprec = it + 1
        Else
            Iprec = it
        End If
        strNom = Range("A" & it + 1).Value
    End If
    it = it + 1
Loop
'insere la dernière formule
'Range("D" & it).FormulaLocal = "=somme(D" & Iprec & ":D" & it - 1 & ")"
'Range("D" & it).Font.Size = 16
'Range("D" & it).VerticalAlignment = xlTop
'Range("A" & it).Value = "SEM " + strNom
'Range("A" & it).Font.Bold = True
'Range("A" & it).RowHeight = 40
'Range("A" & it).Font.Size = 16
'Range("A" & it).VerticalAlignment = xlTop
 
Range("P1:AW65500").Clear
 
Range("A2").Select 'deselection
 
End Sub

04/04/2022, 15h53
Pierre Fauconnier

Je ne vois rien qui concerne sql dans le code donné ^^

Ce que je voulais dire, c'est que recréer une commande sql (la ligne de code avec Select ... From) en reconstituant le texte de la commande avec les paramètres de la clause WHERE n'est pas une bonne idée car le SQL et VBA ne fonctionnent pas de la même manière, et certains caractères vont poser problème (% ? , . ').

Cela dit, si ça fonctionne comme cela a été proposé, continue ainsi.

1 pièce(s) jointe(s)

Hello, je reviens vers vous aujourd’hui. J'ai essayé d'adapter le code mais pour du texte mais ça renvoi que des chiffres. Je suppose que dans le code il y a des paramètres à remplacer ?

Pouvez vous m'aider a nouveau svp ?

J'ai mis en rouge ce que j'ai su détecter ! :roll:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function MajSql(LCT As String, Oper As Integer) As Integer
Const User = "*******", Base = "***********", PassWord = "********", Server = "************"
    With CreateObject("AdoDb.connection")
        .Open "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
        With .Execute("Update [LCTE] Set [VarAlphaUtil4]=" & Oper & " Where [CodeLancement]='" & CStr(LCT) & "'" & vbCrLf & "select  @@ROWCOUNT as NB")
            'MajSql = !NB
            '.Close
        End With
        .Close
    End With
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   If Target.Column = 7 Then
    If Trim("" & Cells(Target.Row, "F")) <> "" Then MajSql Cells(Target.Row, "F"), Val(Target)
   End If
End If
End Sub

Bonjour,
j'ai modifier la méthode pour quelle accepte du texte et j'ai fait un requête paramétrable!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function MajSql(LCT As String, Oper As String) As Boolean
Const User = "*******", Base = "***********", PassWord = "********", Server = "************"
    Const adVarChar = 200, adInteger = 3
On Error GoTo fin
With CreateObject("ADODB.Command")
     .ActiveConnection = "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
    .CommandType = 1
    .CommandText = "Update [LCTE] Set [VarAlphaUtil4]=@Oper Where [CodeLancement]=@LCT"
   .Parameters.Append CreateObject("ADODB.Command").CreateParameter("@Oper", adVarChar, 1, 50, Oper)
   .Parameters.Append CreateObject("ADODB.Command").CreateParameter("@LCT", adVarChar, 1, 50, LCT)
   .Execute
   MajSql = True
End With
fin:
On Error GoTo 0
End Function

14/04/2022, 08h07
Philippe ROHL

Merci beaucoup, je vais tester ça dans la journée.;)

Alors j'ai testé mais je n'arrive pas a faire fonctionner le code sur un changement de valeur (change) dans la colonne "Oper". :oops:

Il manque peut-être un bout de code ?
Code:

1 2 3 4 5 6 7 'Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Target.Column = 7 Then If Trim("" & Cells(Target.Row, "F")) <> "" Then MajSql Cells(Target.Row, "F"), Val(Target) End If End If End Sub

14/04/2022, 11h46
Thumb down

Bonjour et désolé

Code:

If Trim("" & Cells(Target.Row, "F")) <> "" Then MajSql Cells(Target.Row, "F"), Trim(Target)

1 pièce(s) jointe(s)

Ne vous excusez pas, c'est plutôt à moi de le faire ! :oops:

Il doit encore y a avoir un petit problème, rien n'est écris dans la bdd ?

Voilà le code en entier que j'ai mis :

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
Function MajSql(LCT As String, Oper As String) As Boolean
Const User = "----", Base = "GPAO_V8_TEST", PassWord = "----", Server = "---------"
    Const adVarChar = 200, adInteger = 3
On Error GoTo fin
With CreateObject("ADODB.Command")
     .ActiveConnection = "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
    .CommandType = 1
    .CommandText = "Update [LCTE] Set [VarAlphaUtil4]=@Oper Where [CodeLancement]=@LCT"
   .Parameters.Append CreateObject("ADODB.Command").CreateParameter("@Oper", adVarChar, 1, 50, Oper)
   .Parameters.Append CreateObject("ADODB.Command").CreateParameter("@LCT", adVarChar, 1, 50, LCT)
   .Execute
   MajSql = True
End With
fin:
On Error GoTo 0
End Function
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   If Target.Column = 7 Then
        If Trim("" & Cells(Target.Row, "F")) <> "" Then MajSql Cells(Target.Row, "F"), Trim(Target)
    End If
End If
End Sub

16/04/2022, 21h18
Pierre Fauconnier

Salut.

Sans avoir testé, je dirais que tu dois supprimer CreateObject("ADODB.Command") aux lignes 8 et 9. Car ton code crée deux nouvelles commandes et affecte un paramètre à chacune d'elle. Du coup, la commande créée plutôt et gérée par le bloc With... End With ne reçoit aucun paramètre. Cela devrait générer une erreur, mais comme tu la contournes par ta gestion d'erreur => tu loupes l'info qu'un problème a été levé.

Le On Error Goto 0 à la fin ne sert à rien car la gestion de l'erreur est toujours limité à la procédure. Le problème de cette "gestion d'erreur", c'est qu'elle t'empêche de récupérer le code de l'erreur pour le traiter en aval.

1 pièce(s) jointe(s)

Bonjour, j'ai modifié en suivant les conseils de Pierre. Suppression des CreateObject("ADODB.Command") ligne 9 et 10 ainsi que On Error Goto 0
Je n'obtiens pas de message d'erreur !

J'ai donc joué à l'apprentie sorcier et supprimé la ligne On Error GoTo fin

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
Function MajSql(LCT As String, Oper As String) As Boolean
Const User = "****", Base = "GPAO_V8_TEST", PassWord = "*****", Server = "*******"
    Const adVarChar = 200, adInteger = 3
'''''On Error GoTo fin
With CreateObject("ADODB.Command")
     .ActiveConnection = "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
    .CommandType = 1
    .CommandText = "Update [LCTE] Set [VarAlphaUtil4]=@Oper Where [CodeLancement]=@LCT"
   .Parameters.Append .CreateParameter("@Oper", adVarChar, 1, 50, Oper)
   .Parameters.Append .CreateParameter("@LCT", adVarChar, 1, 50, LCT)
   .Execute
   MajSql = True
End With
fin:
'''''On Error GoTo 0
End Function
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   If Target.Column = 7 Then
        If Trim("" & Cells(Target.Row, "F")) <> "" Then MajSql Cells(Target.Row, "F"), Trim(Target)
    End If
End If
End Sub

Là, j'obtiens le message suivant :

19/04/2022, 12h29
Pierre Fauconnier

Oui. Désolé. D'habitude, je travaille avec des procédures stockées... Ici, tu travailles avec une requête paramétrée. Donc les paramètres ne sont pas déclarés.

Tu dois modifier ta commande SQL comme suit : .CommandText = "Update [LCTE] Set [VarAlphaUtil4]=? Where [CodeLancement]=?"
19/04/2022, 14h31
Philippe ROHL

C'est super !:D

Ça marche !:ave:
C'est génial !:chin:

:merci:beaucoup pour votre aide ! :ccool:

à toutes fins utiles, voilà les 2 codes:

Pour une variable numérique:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function MajSql(LCT As String, Statut As Integer) As Integer
Const User = "**", Base = "*******", PassWord = "*****", Server = "*******"
    With CreateObject("AdoDb.connection")
        .Open "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
        With .Execute("Update [LCTE] Set [VarNumUtil2]=" & Statut & " Where [CodeLancement]='" & CStr(LCT) & "'" & vbCrLf & "select  @@ROWCOUNT as NB")
                                                                               'LCTE nom de la table, VarNumUtil2 nom du champ modifié, Codelancement nom de champ pour la clause Where
        End With
        .Close
    End With
End Function
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   If Target.Column = 12 Then
    If Trim("" & Cells(Target.Row, "F")) <> "" Then MajSql Cells(Target.Row, "F"), Val(Target) ' F nom de la colonne Excel clause Where
   End If
End If
End Sub

Pour une variable alphanumérique:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function MajSql(LCT As String, Oper As String) As Boolean 'LCT nom de la colonne pour le Where, Oper nom de la colonne modifiée
Const User = "**", Base = "******", PassWord = "*****", Server = "******"
    Const adVarChar = 200, adInteger = 3
With CreateObject("ADODB.Command")
     .ActiveConnection = "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
    .CommandType = 1
    .CommandText = "Update [LCTE] Set [VarAlphaUtil4]=? Where [CodeLancement]=?" 'LCTE nom de la table, VarAlphaUtil4 nom du champ modifié, Codelancement nom de champ pour la clause Where
   .Parameters.Append .CreateParameter("@Oper", adVarChar, 1, 50, Oper)
   .Parameters.Append .CreateParameter("@LCT", adVarChar, 1, 50, LCT)
   .Execute
   MajSql = True
End With
fin:
End Function
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   If Target.Column = 7 Then
        If Trim("" & Cells(Target.Row, "F")) <> "" Then MajSql Cells(Target.Row, "F"), Trim(Target) ' F nom de la colonne Excel clause Where
    End If
End If
End Sub

19/04/2022, 15h34
Pierre Fauconnier

Tant mieux si ça marche...

Cela dit, l'utilisation des paramètres fait qu'il n'y a pas de différence entre les paramètres numériques ou alphanumériques au niveau de la commande SQL. C'est le paramètre lui-même qui est "typé", mais la requête reste la même quel que soit le type des paramètres. On remplace les valeurs par des ? et, très important, on crée les paramètres dans l'ordre d'apparition des ? dans la requête.
19/04/2022, 16h50
Thumb down

Bonjour,
A force de passer d'un langage à un autre je sais plus s'il faut utiliser des ? Ou des @!

Sur Access j'utilises des ? Mais sur SQL Serveur @variable.
19/04/2022, 16h54
Pierre Fauconnier

Citation:

Envoyé par Thumb down

[...]sur SQL Serveur @variable.

Même sur une requête textuelle? Sur une SP, ok parce que l'on déclare les paramètres dans le code de la sp, mais comme on ne les déclare pas dans une requête textuelle, on ne sait pas utiliser @Variable, mais on doit utiliser ?...

Il me semble, en tout cas.
03/05/2022, 09h51
Philippe ROHL

Bonjour tlm.
Hier, les macros ont toutes disparus.
A part le nom des feuilles, il n'y avait absolument plus rien dans "Microsoft Excel Objets"
En fin d'après-midi, j'ai restauré la sauvegarde de midi et pour l'instant tout va bien. :roll:
Avez déjà eu ce genre de problème ?

Voir 40 message(s) de cette discussion en une page