Écrire dans Access depuis Excel - Access pas installé

**Lune1** · 13/11/2015, 16h57

Bonjour,
Je tourne en rond depuis une semaine pour résoudre un problème. Voici les résultats de tests que j'ai fais avec différents utilisateurs:

Utilisateur 1 :
-N'a pas MS Access installé sur son ordinateur.
-Est capable d'écrire dans Access à l'aide de la macro dans Excel
-Message "Excel has stopped working" à la fermeture du fichier Excel

Utilisateur 2:
-N'a pas MS Access installé sur son ordinateur.
-N'est pas capable d'écrire dans Access à l'aide de la macro dans Excel
-Message "Excel has stopped working" à la fermeture du fichier Excel

Utilisateur 3:
-Il a MS Access installé sur son ordinateur.
-Est capable d'écrire dans Access à l'aide de la macro dans Excel
-Message "Excel has stopped working" à la fermeture du fichier Excel

Utilisateur 4 (moi):
-J'ai MS Access installé sur son ordinateur.
-Je suis capable d'écrire dans Access à l'aide de la macro dans Excel.
-Je n'ai pas de message "Excel has stopped working" à la fermeture du fichier Excel

Je ne pense pas que le message "Excel has stopped working" est lié au fait qu’une personne n’a pas MS Access parce que le message apparait pour l'utilisateur 3 (qui a bien MS Access). Pour le message "Excel has stopped working", j'ai essayé de supprimer toutes les feuilles sauf une (parce que Excel ne permet pas de toutes les supprimer), toutes les macros et toutes les références possibles dans l'éditeur de macro, mais le message "Excel has stopped working" est toujours là. Pourtant le message "Excel has stopped working" semble relié à ce fichier spécifique parce que ceux qui ont ce message, ne l'ont pas pour d'autres fichiers Excel. J'envisage de recopier toutes mes macros et tout le contenu de mes feuilles dans un autre fichier en espérant que ça règle le problème. Ce qui est plus problématique est l'impossibilité d'écriture dans MS Access. Certains sites suggéraient l'installation de ACEOLEDB.DLL pour faciliter le transfert des données d'un programme à l'autre. J'ai vérifié et l'utilisateur 2 l'a bien dans son ordinateur. Ce n'est donc pas à cause de ça que ça transfert pas. Qu'est-ce qui peut bien empêcher l'écriture dans Access pour l'utilisateur 2, alors que l'utilisateur 1 peut le faire et que tout deux n'ont pas Access installé sur leurs ordinateurs? Est-ce qu'il y a des réglages que je devrais verifier?

Voici à titre d'information ma macro. Je ne crois pas qu'elle contient d'erreur puisqu'elle fonctionne pour plusieurs utilisateurs dont l'utilisateur 1 qui n'a pas MS Access installé sur son ordinateur.

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
Sub ADOTest()
'exports data from the active worksheet to a table in an Access database
Dim cn As ADODB.Connection, RS As ADODB.Recordset, r As Long
Dim oRange As Range
Dim JRange As Range
 
Set JRange = ThisWorkbook.Worksheets("Départements").Range("M1")
 
 
Application.ScreenUpdating = False
Application.Calculation = xlManual
 
Worksheets("Parametres").Select
 
If Range("C70").Value = "Oui" Or Range("C70").Value = "" Then
 
    Compte = Application.WorksheetFunction.CountA(Range("B2:B50"))
 
    If Compte = 0 Then
 
        Set cn = New ADODB.Connection
        cn.Open "provider = microsoft.ace.oledb.12.0;" & _
        "Data Source=\\sharepoint.ca\Shared Documents\DataBase51.accdb;"
 
        'open a recordset
        Set RS = New ADODB.Recordset
 
 
        Table = "Table1"
 
 
        RS.Open Table, cn, adOpenKeyset, adLockOptimistic, adCmdTable
        'all records in a table
        r = 38 'the start row in the worksheet
 
        With RS
            Do
                If RS.Fields("NoEmployé") = UserName Then
                    RS.Delete
                    RS.Update
                End If
                RS.MoveNext
            Loop Until RS.EOF
        End With
 
        ThisWorkbook.Activate
        Worksheets("TB OPÉRATIONNEL (global)").Select
 
 
 
 
        Range("E9").Select
        Do While ActiveCell.Offset(0, 1).Value <> ""
 
            If ActiveCell.Value <> "" Then
                With RS
                r = ActiveCell.Row
                .AddNew 'create a new record
                'add values to each field in the record
 
                .Fields("NoEmployé") = UserName
                .Fields("Quadrant") = Range("F" & r).Formula
                .Fields("Indicateur") = Range("G" & r).Formula
                .Fields("Cible") = Range("H" & r).Formula
                .Fields("RendementPrécédent") = Range("J" & r).Formula
                .Fields("AVR") = Range("L" & r).Formula
                .Fields("MAI") = Range("N" & r).Formula
                .Fields("JUIN") = Range("P" & r).Formula
                .Fields("JUIL") = Range("R" & r).Formula
                .Fields("AOUT") = Range("T" & r).Formula
                .Fields("SEPT") = Range("V" & r).Formula
                .Fields("OCT") = Range("X" & r).Formula
                .Fields("NOV") = Range("Z" & r).Formula
                .Fields("DEC") = Range("AB" & r).Formula
                .Fields("JAN") = Range("AD" & r).Formula
                .Fields("FÉV") = Range("AF" & r).Formula
                .Fields("MARS") = Range("AH" & r).Formula
                .Fields("YTD") = Range("AJ" & r).Formula
                .Fields("Inclure") = Range("AL" & r).Formula
                .Fields("TypeDonnées") = Range("H" & r).NumberFormat
                .Fields("Com") = Range("AO" & r).Formula
                'add more fields if necessary…
                .Update 'stores the new record
                End With
            End If
        ActiveCell.Offset(1, 0).Select
 
        Loop
 
 
        ThisWorkbook.Activate
 
 
        RS.Close
        Set RS = Nothing
        cn.Close
        Set cn = Nothing
    End If
End If
 
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Invité · 13/11/2015, 17h11

Bonjour,
Retire ms les références ado de to projet!
http://www.developpez.net/forums/d15...e/#post8415988

Code :

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

1
2
3
4
 
Dim cn As Object, rs as Object
Set cn =creatobject(" ADODB.Connection")
Set RS AQ=creatobject("ADODB.Recordset")

**Lune1** · 16/11/2015, 15h34

Bonjour,
Merci pour ces conseils. Je jure que je vais finir par l'apprendre.

Malheureusement, il doit encore y avoir quelque chose qui m'échappe : j'ai testé avec mon utilisateur 2 et ça n'a pas fonctionné. Il semble bien y avoir une connexion qui se fait parce que le site de collaboration montre qu'il est le dernier utilisateur à avoir modifié la base de données Access, mais quand je l'ouvre, je constate que ses enregistrements n'ont pas enregistré. J'ai testé aussi avec mon ordinateur et comme d'habitude ça fonctionne parfaitement de mon côté.

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
Sub ADOTest()
'exports data from the active worksheet to a table in an Access database
Dim cn As Object, RS As Object, r As Long
Dim oRange As Range
Dim JRange As Range
 
Set JRange = ThisWorkbook.Worksheets("Départements").Range("M1")
 
 
Application.ScreenUpdating = False
Application.Calculation = xlManual
 
Worksheets("Parametres").Select
 
If Range("C70").Value = "Oui" Or Range("C70").Value = "" Then
 
    Compte = Application.WorksheetFunction.CountA(Range("B2:B50"))
 
    If Compte = 0 Then
 
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "provider = microsoft.ace.oledb.12.0;" & _
        "Data Source=\\sharepoint.ca\Shared Documents\DataBase51.accdb;"
 
        'open a recordset
        Set RS = CreateObject("ADODB.Recordset")
 
 
        Table = "Table1"
 
 
        RS.Open Table, cn, adOpenKeyset, adLockOptimistic, adCmdTable
        'all records in a table
        r = 38 'the start row in the worksheet
 
        With RS
            Do
                If RS.Fields("NoEmployé") = UserName Then
                    RS.Delete
                    RS.Update
                End If
                RS.MoveNext
            Loop Until RS.EOF
        End With
 
        ThisWorkbook.Activate
        Worksheets("TB OPÉRATIONNEL (global)").Select
 
 
 
 
        Range("E9").Select
        Do While ActiveCell.Offset(0, 1).Value <> ""
 
            If ActiveCell.Value <> "" Then
                With RS
                r = ActiveCell.Row
                .AddNew 'create a new record
                'add values to each field in the record
 
                .Fields("NoEmployé") = UserName
                .Fields("Quadrant") = Range("F" & r).Formula
                .Fields("Indicateur") = Range("G" & r).Formula
                .Fields("Cible") = Range("H" & r).Formula
                .Fields("RendementPrécédent") = Range("J" & r).Formula
                .Fields("AVR") = Range("L" & r).Formula
                .Fields("MAI") = Range("N" & r).Formula
                .Fields("JUIN") = Range("P" & r).Formula
                .Fields("JUIL") = Range("R" & r).Formula
                .Fields("AOUT") = Range("T" & r).Formula
                .Fields("SEPT") = Range("V" & r).Formula
                .Fields("OCT") = Range("X" & r).Formula
                .Fields("NOV") = Range("Z" & r).Formula
                .Fields("DEC") = Range("AB" & r).Formula
                .Fields("JAN") = Range("AD" & r).Formula
                .Fields("FÉV") = Range("AF" & r).Formula
                .Fields("MARS") = Range("AH" & r).Formula
                .Fields("YTD") = Range("AJ" & r).Formula
                .Fields("Inclure") = Range("AL" & r).Formula
                .Fields("TypeDonnées") = Range("H" & r).NumberFormat
                .Fields("Com") = Range("AO" & r).Formula
                'add more fields if necessary…
                .Update 'stores the new record
                End With
            End If
        ActiveCell.Offset(1, 0).Select
 
        Loop
 
 
        ThisWorkbook.Activate
 
 
        RS.Close
        Set RS = Nothing
        cn.Close
        Set cn = Nothing
    End If
End If
 
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

____________________
Mes pensées sont avec le peuple français en ces jours difficiles.

Invité · 16/11/2015, 15h47

bonjour,

j'imagine que tous les utilisateurs peuvent ce connecter en même temps! là il faut autoriser les connexion multiple.

dans les option d'Access:
Nom : Sans titre.png
Affichages : 1442
Taille : 63,3 Ko

Nom : Sans titre.png
Affichages : 1442
Taille : 63,3 Ko

attention l'administrateur bloque en mode exclusif la base!

**Lune1** · 16/11/2015, 19h35

J'avais déjà "Mode partagé" (mode d'ouverture par défaut) coché et "Auncun" (verrouillage par défaut) coché, mais j'ai décoché "Ouvrir avec enregistrement verrouillé" pour voir si ça allait faire une différence. Toujours pas de succès.

C'est un vrai mystère!

Invité · 16/11/2015, 20h04

Code :

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

1
2
 
   RS.Open SQL, Connexion, 1, 3

les variables ado ne fonctionne pas avec CreateObject (adOpenKeyset, adLockOptimistic, adCmdTable)

**Lune1** · 16/11/2015, 20h43

Étant donné que je n'ai pas "SQL" dans la ligne suggérée :

Code :

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

RS.Open SQL, Connexion, 1, 3

J'ai remplacé "SQL" par "cn" pour essayer de l'adapter à mon code. J'ai donc remplacé la ligne :

Code :

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

RS.Open Table, cn, adOpenKeyset, adLockOptimistic, adCmdTable

Par:

Code :

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

RS.Open cn, Connexion, 1, 3

J'ai eu l'erreur : Erreur d'exécution 3001 Arguments are of the wrong type, are out of range, or are in conflit with one another.

J'ai essayé aussi :

Code :

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

RS.Open Table, Connexion, 1, 3

Parce que j'essaie d'ouvrir la table, mais ça donne encore une autre erreur.

Dans un autre code qu'on avait fait précédemment, on a :

Code :

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

1
2
3
4
     SQL = "Select " & champRetour & " FROM " & tbl & " Where " & _
        ChampRecherche & "='" & valeurRecherche & "'"
    Set RS = CreateObject("ADODB.Recordset")
 RS.Open SQL, Connexion, 1, 3

Je ne sais pas comment l'adapter parce que cette fois-ci, je ne veux pas seulement lire dans la base de données, mais supprimer et ajouter des enregistrements.

Invité · 16/11/2015, 21h32

dans l'entête d'un module séparé

Code Module standard :

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

1
2
3
4
5
Public Enum ConsAdo
adOpenKeyset = 1
adLockOptimistic = 3
adCmdTable = 2
End Enum

Code :

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

RS.Open Table, cn, adOpenKeyset, adLockOptimistic, adCmdTable

Code :

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

1
2
sql="delete [table] where [champ]='toto';"
cn.execut sql

**Lune1** · 17/11/2015, 17h02

Merci, ça fonctionne très bien sur mon ordinateur pour supprimer les champs. Avant de le tester avec mon utilisateur 2, j'aurais aimé faire aussi le code pour ajouter un enregistrement.

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
 
        r = ActiveCell.Row
	Donnée1 = Range("F" & r).Formula
        Donnée2 = Range("G" & r).Formula
        Donnée3 = Range("H" & r).Formula
        Donnée4 = Range("J" & r).Formula
        Donnée5 = Range("L" & r).Formula
        Donnée6 = Range("N" & r).Formula
        Donnée7 = Range("P" & r).Formula
        Donnée8 = Range("R" & r).Formula
        Donnée9 = Range("T" & r).Formula
        Donnée10 = Range("V" & r).Formula
        Donnée11 = Range("X" & r).Formula
        Donnée12 = Range("Z" & r).Formula
        Donnée13 = Range("AB" & r).Formula
        Donnée14 = Range("AD" & r).Formula
        Donnée15 = Range("AF" & r).Formula
        Donnée16 = Range("AH" & r).Formula
        Donnée17 = Range("AJ" & r).Formula
        Donnée18 = Range("AL" & r).Formula
        Donnée19 = Range("H" & r).NumberFormat
            '.Fields("DEPT") = "100000"
        Donnée20 = Range("AO" & r).Formula
        Sql2 = "INSERT INTO Table1 (NoEmployé, Quadrant, Indicateur, Cible, RendementPrécédent, AVR, MAI, JUIN, JUIL, AOUT, SEPT, OCT, NOV, DEC, JAN, FÉV, MARS, YTD, TypeDonnées, Inclure, DEPT, Com) VALUES ('Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7', 'Test8', 'Test9', 'Test10', 'Test11', 'Test12', 'Test13', 'Test14', 'Test15', 'Test16', 'Test17', 'Test18', 'Test19', 'Test20', 100000, 'Test22');"
        cn.Execute Sql2

Désolée pour la longue ligne commençant pas "Sql2". J'ai essayé de la séparer en plusieurs lignes, mais Excel ne me le permettait pas. Tous mes champs dans Access sont en texte sauf le champs DEPT qui est numérique. Ce que j'essaie de faire, c'est de faire fonctionner la ligne Sql2 avec les données bidons (Test1, Test2, etc.) et une fois que ça fonctionnera, j'essayerai de les remplacer par mes variables (Donnée1, Donnée2, etc.). Il me met une erreur de syntaxe, mais j'ai essayé plusieurs choses sans succès. Voici mon code au complet:

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
Sub ADOTest()
'exports data from the active worksheet to a table in an Access database
Dim cn As Object, RS As Object, r As Long
Dim oRange As Range
Dim JRange As Range
 
Set JRange = ThisWorkbook.Worksheets("Départements").Range("M1")
 
 
Application.ScreenUpdating = False
Application.Calculation = xlManual
 
Worksheets("Parametres").Select
 
If Range("C70").Value = "Oui" Or Range("C70").Value = "" Then
 
    Compte = Application.WorksheetFunction.CountA(Range("B2:B50"))
 
    If Compte = 0 Then
 
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "provider = microsoft.ace.oledb.12.0;" & _
        "Data Source=\\sharepoint.ca\Shared Documents\DataBase51.accdb;"
 
        'open a recordset
        Set RS = CreateObject("ADODB.Recordset")
 
 
        Table = "Table1"
 
 
        RS.Open "Table1", cn, adOpenKeyset, adLockOptimistic, adCmdTable
        'all records in a table
        r = 38 'the start row in the worksheet
 
	Sql = "delete * FROM Table1 WHERE NoEmployé='" & UserName & "';"
        cn.Execute Sql
 
        ThisWorkbook.Activate
        Worksheets("TB OPÉRATIONNEL (global)").Select
 
 
 
 
        Range("E9").Select
        Do While ActiveCell.Offset(0, 1).Value <> ""
 
            If ActiveCell.Value <> "" Then
                r = ActiveCell.Row
		Donnée1 = Range("F" & r).Formula
                Donnée2 = Range("G" & r).Formula
                Donnée3 = Range("H" & r).Formula
                Donnée4 = Range("J" & r).Formula
                Donnée5 = Range("L" & r).Formula
                Donnée6 = Range("N" & r).Formula
                Donnée7 = Range("P" & r).Formula
                Donnée8 = Range("R" & r).Formula
                Donnée9 = Range("T" & r).Formula
                Donnée10 = Range("V" & r).Formula
                Donnée11 = Range("X" & r).Formula
                Donnée12 = Range("Z" & r).Formula
                Donnée13 = Range("AB" & r).Formula
                Donnée14 = Range("AD" & r).Formula
                Donnée15 = Range("AF" & r).Formula
                Donnée16 = Range("AH" & r).Formula
                Donnée17 = Range("AJ" & r).Formula
                Donnée18 = Range("AL" & r).Formula
                Donnée19 = Range("H" & r).NumberFormat
               '.Fields("DEPT") = "100000"
                Donnée20 = Range("AO" & r).Formula
               Sql2 = "INSERT INTO Table1 (NoEmployé, Quadrant, Indicateur, Cible, RendementPrécédent, AVR, MAI, JUIN, JUIL, AOUT, SEPT, OCT, NOV, DEC, JAN, FÉV, MARS, YTD, TypeDonnées, Inclure, DEPT, Com) VALUES ('Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7', 'Test8', 'Test9', 'Test10', 'Test11', 'Test12', 'Test13', 'Test14', 'Test15', 'Test16', 'Test17', 'Test18', 'Test19', 'Test20', 100000, 'Test22');"
                cn.Execute Sql2
 
 
            End If
        ActiveCell.Offset(1, 0).Select
 
        Loop
 
 
        ThisWorkbook.Activate
 
 
        RS.Close
        Set RS = Nothing
        cn.Close
        Set cn = Nothing
    End If
End If
 
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Invité · 17/11/2015, 17h38

Place toujours tes champs entre crochet!

Par exemple date est un mot réservé [date] est un champ, ma date c'est une erreur. [ma date] est un champ! Si tu encadre tous tes champs plus d'erreur de syntaxe!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
 
Sql2 = "INSERT INTO [Table1] ([NoEmployé], [Quadrant], [Indicateur], [Cible],"
Sql2 =  Sql2 & "[RendementPrécédent], AVR, MAI, JUIN, JUIL, [AOUT], [SEPT], "
Sql2 =  Sql2 & "OCT, NOV, DEC, JAN, FÉV, MARS, YTD, TypeDonnées, Inclure,"
Sql2 =  Sql2 & " DEPT, Com) VALUES " 
Sql2 =  Sql2 & "('Test1', 'Test2', 'Test3', 'Test4', 'Test5', "
Sql2 =  Sql2 & "'Test6', 'Test7', 'Test8', 'Test9', 'Test10', 'Test11', "
Sql2 =  Sql2 & "'Test12', 'Test13', 'Test14', 'Test15', 'Test16', "
Sql2 =  Sql2 & "'Test17', 'Test18', 'Test19', 'Test20', 100000, 'Test22');"
        cn.Execute Sql2

**Lune1** · 18/11/2015, 15h39

Merci, mettre les crochets a résolu le problème d'erreur de syntaxe. De plus, on a découvert que mon utilisateur 2 avait un fichier personnal.xlsb qui interférait apparemment avec les autres macros puisque dès qu'on l'a supprimé la connexion avec Access s'est faite. Il était le seul qui ne pouvait faire la connexion et maintenant, ça fonctionne pour tout le monde.

Concernant le problème de "Excel has stopped working", je l'ai résolu en recopiant toutes mes macros et le contenu de mes feuilles dans un nouveau fichier Excel. Recommencer du début était ennuyant, ça m'a tout de même pris beaucoup moins de temps que la première fois que j'ai construit le fichier.

Voici mon code final pour ceux que ça intéresse:

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
Sub ADOTest()
'exports data from the active worksheet to a table in an Access database
Dim cn As Object, RS As Object, r As Long
Dim oRange As Range
Dim JRange As Range
 
Set JRange = ThisWorkbook.Worksheets("Départements").Range("M1")
 
 
Application.ScreenUpdating = False
Application.Calculation = xlManual
 
Worksheets("Parametres").Select
 
If Range("C70").Value = "Oui" Or Range("C70").Value = "" Then
 
    Compte = Application.WorksheetFunction.CountA(Range("B2:B50"))
 
    If Compte = 0 Then
 
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "provider = microsoft.ace.oledb.12.0;" & _
        "Data Source=\\sharepoint.ca\Shared Documents\DataBase51.accdb;"
 
        'open a recordset
        Set RS = CreateObject("ADODB.Recordset")
 
 
        Table = "Table1"
 
 
        RS.Open "Table1", cn, adOpenKeyset, adLockOptimistic, adCmdTable
        'all records in a table
        r = 38 'the start row in the worksheet
 
	Sql = "delete * FROM Table1 WHERE NoEmployé='" & UserName & "';"
        cn.Execute Sql
 
        ThisWorkbook.Activate
        Worksheets("TB OPÉRATIONNEL (global)").Select
 
 
 
 
        Range("E9").Select
        Do While ActiveCell.Offset(0, 1).Value <> ""
 
            If ActiveCell.Value <> "" Then
                   	r = ActiveCell.Row
        		Donnée1 = Range("F" & r).Formula
        		Donnée2 = Range("G" & r).Formula
        		Donnée3 = Range("H" & r).Formula
        		Donnée4 = Range("J" & r).Formula
        		Donnée5 = Range("L" & r).Formula
        		Donnée6 = Range("N" & r).Formula
        		Donnée7 = Range("P" & r).Formula
        		Donnée8 = Range("R" & r).Formula
        		Donnée9 = Range("T" & r).Formula
        		Donnée10 = Range("V" & r).Formula
        		Donnée11 = Range("X" & r).Formula
        		Donnée12 = Range("Z" & r).Formula
        		Donnée13 = Range("AB" & r).Formula
        		Donnée14 = Range("AD" & r).Formula
        		Donnée15 = Range("AF" & r).Formula
        		Donnée16 = Range("AH" & r).Formula
        		Donnée17 = Range("AJ" & r).Formula
        		Donnée18 = Range("H" & r).NumberFormat
        		Donnée19 = Range("AL" & r).Formula
            		'.Fields("DEPT") = "100000"
        		Donnée20 = Range("AO" & r).Formula
        		'Sql2 = "INSERT INTO Table1 (NoEmployé, Quadrant, Indicateur, Cible, RendementPrécédent, AVR, MAI, JUIN, JUIL, AOUT, SEPT, OCT, NOV, DEC, JAN, FÉV, MARS, YTD, Inclure, TypeDonnées, DEPT, Com) VALUES ('Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7', 'Test8', 'Test9', 'Test10', 'Test11', 'Test12', 'Test13', 'Test14', 'Test15', 'Test16', 'Test17', 'Test18', 'Test19', 'Test20', 100000, 'Test22')"
        		Sql2 = "INSERT INTO [Table1] ([NoEmployé], [Quadrant], [Indicateur], [Cible],"
        		Sql2 = Sql2 & "[RendementPrécédent], [AVR], [MAI], [JUIN], [JUIL], [AOUT], [SEPT], "
        		Sql2 = Sql2 & "[OCT], [NOV], [DEC], [JAN], [FÉV], [MARS], [YTD], [TypeDonnées], [Inclure],"
        		Sql2 = Sql2 & " [DEPT], [Com]) VALUES "
        		Sql2 = Sql2 & "('" & UserName & "', '" & Donnée1 & "', '" & Donnée2 & "', '" & Donnée3 & "', '" & Donnée4 & "', "
        		Sql2 = Sql2 & "'" & Donnée5 & "', '" & Donnée6 & "', '" & Donnée7 & "', '" & Donnée8 & "', '" & Donnée9 & "', '" & Donnée10 & "', "
        		Sql2 = Sql2 & "'" & Donnée11 & "', '" & Donnée12 & "', '" & Donnée13 & "', '" & Donnée14 & "', '" & Donnée15 & "', "
        		Sql2 = Sql2 & "'" & Donnée16 & "', '" & Donnée17 & "', '" & Donnée18 & "', '" & Donnée19 & "', 100000, '" & Donnée20 & "');"
        		cn.Execute Sql2 
 
            End If
        ActiveCell.Offset(1, 0).Select
 
        Loop
 
 
        ThisWorkbook.Activate
 
 
        RS.Close
        Set RS = Nothing
        cn.Close
        Set cn = Nothing
    End If
End If
 
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Écrire dans Access depuis Excel - Access pas installé [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager