Discussion :

[nisrine hammout]

Bonjour,
J'ai besoin de votre aide je suis entrain de faire un code vba à travers lequel il rempli des tableaux sous excel

Quand j'ai ajouté mon update au code il m'a donné un message "aucune valeur donné pour un ou plusieurs des parametres requis "
Si quelqu'un peut m'aider

voila mon code

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
Sub Test()
Dim Cn As Object, Rst, rstmin, rstmax As Object, Sql, sqlmin, sqlmax As String, Fi1 As String, Fi2 As String, client As String, safran As String
 
    Fi2 = "C:\Users\admin\Desktop\nouveau travail\safran.xlsm"
 
    Fi1 = "C:\Users\admin\Desktop\nouveau travail\Copie de FormIDD_DERX189100_RETOUR_SES.xlsm"
client = "Description_et_Decision_Techn"
safran = "Feuil1"
Set Cn = OpenConnetion(Fi1, False)
If TypeName(Cn) = "Nothing" Then Exit Sub
 
Sql = "UPDATE  [" & client & "$] SET [F55]=[AEE] WHERE [" & client & "$].[F10] in  ( SELECT a.[F10] FROM [" & client & "$] a ,(Select * from [" & safran & "$] in  '" & Fi2 & "'  'excel 8.0;HDR=no;IMEX=1;' ) as  b WHERE   a.[F8]=b.[F4] and a.[F5]=b.[F1] and a.[F9]=b.[F5] and a.[F10]>b.[F9] and a.[F10] < b.[F10]) "
 
 
Set Rst = OpenRecordSet(Sql, Cn)
 
If TypeName(Rst) = "Nothing" Then Exit Sub
 
Rst.Close: Cn.Close
Set Rst = Nothing: Set Cn = Nothing
 
 
End Sub
 
Public Function OpenConnetion(FichierXls As String, AvecTitre As Boolean) As Object
On Error Resume Next
Dim HDR
If Dir(FichierXls) = "" Then MsgBox FichierXls & vbCrLf & "Pas trouvé": Exit Function
HDR = Array("No", "Yes")
Set OpenConnetion = CreateObject("ADODB.Connection")
With OpenConnetion
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FichierXls & ";Extended Properties=""Excel 12.0 Xml;HDR=" & HDR(Abs(AvecTitre)) & ";IMEX=1;"""
        .Open
        If Err Then
            MsgBox Err.Description
            Set OpenConnetion = Nothing
        End If
        Err.Clear
        On Error GoTo 0
End With
End Function
Public Function OpenRecordSet(Sql, Cn As Object) As Object
'Retourne un RecordeSet
On Error Resume Next
Set OpenRecordSet = CreateObject("ADODB.Recordset")
OpenRecordSet.Open Sql, Cn, 1, 3
If Err Then
    MsgBox Err.Description
Set OpenRecordSet = Nothing
End If
Err.Clear
On Error GoTo 0
End Function

et voila mon update

Code :

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

"UPDATE  [" & client & "$] SET [F55]=[AEE] WHERE [" & client & "$].[F10] in  ( SELECT a.[F10] FROM [" & client & "$] a ,(Select * from [" & safran & "$] in  '" & Fi2 & "'  'excel 8.0;HDR=no;IMEX=1;' ) as  b WHERE   a.[F8]=b.[F4] and a.[F5]=b.[F1] and a.[F9]=b.[F5] and a.[F10]>b.[F9] and a.[F10] < b.[F10]) "

[Invité]

avant de faire des chose trop compliquées il faut réussir un Update! et après sélectionner les valeurs du deuxième fichier, et en fin regrouper les deux requête.

j'ai fait quelles que modifications dans le code en fonction de tes fichier.

Code là je me contante que de l'update :

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
Sub Test()
Dim Cn As Object, Rst As Object, Sql As String, Fi1 As String, Fi2 As String, client As String, safran  As String
 Fi2 = "C:\Users\admin\Desktop\nouveau travail\safran.xlsm"
Fi1 = "C:\Users\admin\Desktop\nouveau travail\Copie de FormIDD_DERX189100_RETOUR_SES.xlsm"
client = "[Description_et_Decision_Techn$A3:BL1048576]"  'ici je défini l'onglet ainsi que la plage de cellules [A3] est la ligne ou ce trouve le titre des colonnes!
safran = "[Feuil1$B3:J1048576]"
Set Cn = OpenConnetion(Fi1, True) 'ici j'ouvre une connexion adodb via une fonction la prelière ligne de la plage est le titre des colonnes True/False
If TypeName(Cn) = "Nothing" Then Exit Sub 'si la connexion ne se fait pas je quitte la sub
 
'la je formule ma requête frm1 et ma sous requête frm2
'il est possible d'imbriquer de requête frm2 fait un jointure externe au deuxième fichier Excel
Sql = "Select * from " & safran & " in '" & Fi2 & "'  'excel 8.0;HDR=yes;IMEX=1;' "
 
Sql = "Update " & client & " Set [Sanction] = 'Ko'"
Cn.Execute Sql
Cn.Close
Set Rst = Nothing: Set Cn = Nothing
End Sub
 
Public Function OpenConnetion(FichierXls As String, AvecTitre As Boolean) As Object
'ouvre la connexion au fichier Excel
'FichierXls non et chemin complet du fichier
'AvecTitre précise si la première ligne de l'onglet est les entête de colonnes ou pas
'rzutourne la connexion
On Error Resume Next
Dim HDR
If Dir(FichierXls) = "" Then MsgBox FichierXls & vbCrLf & "Pas trouvé": Exit Function ' versifie si le fichier existe
HDR = Array("No", "Yes")
Set OpenConnetion = CreateObject("ADODB.Connection") 'Instancie un objet adosb c'est mieux que d'utiliser le références
With OpenConnetion
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FichierXls & ";Extended Properties=""Excel 12.0 Xml;HDR=" & HDR(Abs(AvecTitre)) & ";IMEX=1;"""
        .Open
        If Err Then
            MsgBox Err.Description
            Set OpenConnetion = Nothing
        End If
        Err.Clear
        On Error GoTo 0
End With
End Function
Public Function OpenRecordSet(Sql, Cn As Object) As Object 'Retourne un recordset
'Retourne un RecordeSet
On Error Resume Next
Set OpenRecordSet = CreateObject("ADODB.Recordset")
OpenRecordSet.Open Sql, Cn, 1, 3 'ouvre un recordset sur la requête SQL pour la connexion en lecteur écriture et ajou dynamique
If Err Then
    MsgBox Err.Description
Set OpenRecordSet = Nothing
End If
Err.Clear
On Error GoTo 0
End Function

[nisrine hammout]

le code que tu m'as donné me donne cette erreur
https://scontent-mrs1-1.xx.fbcdn.net...9d&oe=579BF686

[Invité]

oui je regarde pour contourner le problème car là c'est un problème Excel!
je regarde si le problème provient de la plage de cellules ou pas, de cellule fusionné ou pas!

[nisrine hammout]

Oui il y a des cellules qui sont fusionnées