[VBA-E]Execution d'une macro access sous excel VBA

Version imprimable

Bonjour a tous jsui nouvelle sur le forum et biensur g besoin d'aide. voila mon pb : je fais un travail sous excel et j'aimerai pouvoir executer une macro access sous excel VBA. voila mon code:
Code:

1 2 3 4 5 6 7 8 9 10 Sub ExecuteMacroAccess() Dim MyBase As New Access.Application Set MyBase = New Access.Application MyBase.OpenCurrentDatabase "G:\My Documents\graphs\Silos.mdb" MyBase.Visible = False MyBase.DoCmd.RunMacro "MacroTest", , "" MyBase.Quit Set MyBase = Nothing End Sub
Sauf que je recoi un msg d'erreur : Application-defined or object-defined error (erreur 2391)
si quelqu'un peut m'aider plz j'en ai vraiment besoin
merci d'avance

20/04/2006, 10h10
romrai

Salut,

juste deux questions:

1/ est ce que t'a bien selectionné la librerie access dans outils-reférence?

2/ si oui, l'erreur se trouve sur quelle ligne de ton code?
20/04/2006, 16h58
virtualinsanity

Merci Romrai de me repondre.
wi j'ai bien ajoute la biblio et kan g le message la ligne ou se trouve l'erreur ne s'affiche pas le compilateur ne la precise pas et ds la boite de message g le choix entre OK ou HELP c tt! je sai ke c pa suffisant kom infos mai j'espere ke tu pourra m'aider merci
20/04/2006, 17h00
Vesta

Ca foire ou exactement?

Met un point d'arret en fesant F9 sur la premiere ligne et relance la procédure... Ensuite continue en appuyant sur F8 pour executer l'instruction suivante... Ainsi dessuite pour savoir a quel niveau est l'erreur
20/04/2006, 17h05
virtualinsanity

ca foire la:
MyBase.DoCmd.RunMacro "MacroTest", , ""
sur cette commande

Essaie comme ca

Code:

1
2
3
4
5
6
7
8
9
Sub ExecuteMacroAccess()
Dim MyBase As New Access.Application
Set MyBase = New Access.Application
MyBase.OpenCurrentDatabase "G:\My Documents\graphs\Silos.mdb"
MyBase.Visible = False
MyBase.DoCmd.RunMacro "MacroTest"
MyBase.Quit
Set MyBase = Nothing
End Sub

20/04/2006, 17h40
virtualinsanity

Merci pr ton aide
la ca foire apres:
MyBase.OpenCurrentDatabase "G:\My Documents\graphs\Silos.mdb"
Je sai vraiment pa prkoi
en fait ce ke je ve faire c peu etre un peu con mai je ve importer des tables d'excel vers access et j'utilise la macro transfertspreadsheet parceke autrement je devrai ouvrir une connexion a la base de donnee et ensuite specifier ou je ve ke les champs soi enregistrer et je me sui di k'en utilisan cette macro ca serai + rapidemen programmable (mai + rapidemen executable???) voila
20/04/2006, 17h53
Vesta

Mais chez moi ca me demande d'activer le code VB dans la base de donnée juste apres l'ouverture...

Est ce que le chemin de la base est bien ok?
20/04/2006, 18h02
virtualinsanity

we le chemin est bon
tu as essayer ac la macro transfertspreadsheet? la je sui entrain d'essayer d'ouvrir une connexion ADO mai la aussi ca foir sur le provider.:cry:
20/04/2006, 18h09
Vesta

ca doit servir a quoi?

Pourquoi ne pas simplement dans acces créer une table liée a ton fichier excel?
20/04/2006, 18h17
virtualinsanity

en fait la jsui en stage de fin d'etudes et la boite pr ki je fai ca ils bossent tt le tps ac excel (veulent pa change) et les operateurs ne savent pas utiliser access (et ne l'ont pa sur leurs postes) dc jsui obligee de le faire sur excel. et kom je doi faire un archivage et ke eux le faisai sur excel!!! je me sui di autan le faire sur access et faire des formulaires pr consulation des archive pr les manager (ki eux ont access)
20/04/2006, 18h20
Vesta

ok compris je cogite et je te répond lol
20/04/2006, 18h24
virtualinsanity

lol merci j'attend ta reponse ;)

A vérifié mais ca fonctionne , attention, ne pas changer de sheet lors de l'exportation... Il faudra peu etre définir feuille une dans les parametres

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
Sub Exportdata(DataRange As Range, TableName As String)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim num_records As Integer
 
    ' Nom base de donnée
    db_file = "c:\test.mdb"
 
    ' Ouvre une connection 
     Set conn = New ADODB.Connection
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & db_file & ";" & _
        "Persist Security Info=False"
 
    conn.Open
 
    ' Supprime la table si existante
    On Error Resume Next
    conn.Execute "DROP TABLE " & TableName
    On Error GoTo 0
 
 
    ' Crée la table
    StrSQL = "CREATE TABLE " & TableName & " ("
 
    For Each cell In DataRange.Rows(1).Cells
 
        If IsNumeric(DataRange.Rows(2).Cells(1, cell.Column)) Then
            StrSQL = StrSQL & " " & cell.Value & " INTEGER, "
        Else
            StrSQL = StrSQL & " " & cell.Value & " VARCHAR(40), "
        End If
 
    Next
    StrSQL = Mid(StrSQL, 1, (Len(StrSQL) - 2))
    StrSQL = StrSQL & ")"
    conn.Execute StrSQL
 
    'conn.Execute _
        "CREATE TABLE " & TableName & "(" & _
            "EmployeeId INTEGER      NOT NULL," & _
            "LastName   VARCHAR(40)  NOT NULL," & _
            "FirstName  VARCHAR(40)  NOT NULL)"
 
 
    ' Remplis la  table.
 
    For Each cell In DataRange.Columns(1).Cells
        If Not (cell.Row = 1) Then
            vals = ""
            For Each cell2 In DataRange.Rows(cell.Row).Cells
                vals = vals & "'" & Cells(cell2.Row, cell2.Column) & "', "
            Next
            vals = Mid(vals, 1, Len(vals) - 2)
            conn.Execute "INSERT INTO " & TableName & " VALUES (" & _
               vals & ")"
        End If
    Next
    'conn.Execute "INSERT INTO Employees VALUES (1, " & _
        "'Anderson', 'Amy')"
 
    ' Compté enregistrements dans la table
    Set rs = conn.Execute("SELECT COUNT (*) FROM " & TableName)
    num_records = rs.Fields(0)
 
    conn.Close
 
    MsgBox "Copiés " & num_records & " Enregistrements", _
        vbInformation, "Done"
 
End Sub

Bon boulot

merci bcp pr ton aide finalement jsui passee par l'autre methode ac connexion et kom mes donnes ne son pa tjrs ds les mm colonnes ou ligne donc mon code c ca:

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
Sub FromExcelToAccess()
Sheets("Measures").Select ' Call Sheet Name
'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
' Connect to the Access database
Set cn = New ADODB.Connection
' Pilote connection definition
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
'The Database path
cn.ConnectionString = "G:\My Documents\graphs\Silos.mdb"
'Open Database
cn.Open
' Open a recordset
Set rs = New ADODB.Recordset
rs.Open "Group1", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' All records in a table
r = 7 ' The start row in the worksheet
Do While r < 24
' Repeat until complete
With rs
.AddNew 'Create a new record
' Add values to each field in the record
' Check Date to Time / This handles all Data Tables
.Fields("Group1_Date") = Format((Range("B1").Value), "Short Date")
' Begin the retrival of the Group1 Data
.Fields("Group1_Silo") = Round(Range("A" & r).Value + "0", 2)
.Fields("Group1_Hac_Code") = Range("B" & r).Value ' This handles all Data Tables
.Fields("Group1_Type") = Range("C" & r).Value
.Fields("Group1_Density") = Round(Range("D" & r).Value + "0", 2)
.Fields("Group1_Start_Time") = Format(Range("E6").Value, "Medium Time")
.Fields("Group1_Start_Measure") = Round(Range("E" & r).Value + "0", 2) ' Force zero entry when null
.Fields("Group1_Start_Volume") = Round(Range("I" & r).Value + "0", 2)
.Fields("Group1_Start_Tonnage") = Round(Range("M" & r).Value + "0", 2)
.Fields("Group1_1st_Time") = Format(Range("F6").Value, "Medium Time")
.Fields("Group1_1st_Measure") = Round(Range("F" & r).Value + "0", 2)
.Fields("Group1_1st_Volume") = Round(Range("J" & r).Value + "0", 2)
.Fields("Group1_1st_Tonnage") = Round(Range("N" & r).Value + "0", 2)
.Fields("Group1_2nd_Time") = Format(Range("G6").Value, "Medium Time")
.Fields("Group1_2nd_Measure") = Round(Range("G" & r).Value + "0", 2)
.Fields("Group1_2nd_Volume") = Round(Range("K" & r).Value + "0", 2)
.Fields("Group1_2nd_Tonnage") = Round(Range("O" & r).Value + "0", 2)
.Fields("Group1_3rd_Time") = Format(Range("H6").Value, "Medium Time")
.Fields("Group1_3rd_Measure") = Round(Range("H" & r).Value + "0", 2)
.Fields("Group1_3rd_Volume") = Round(Range("L" & r).Value + "0", 2)
.Fields("Group1_3rd_Tonnage") = Round(Range("P" & r).Value + "0", 2)
r = r + 1 'Next Row
End With
 
Loop
' Closing the database and clearing the rs object
r = 0
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
 
' Copy the last values of the last day in the start values of the new day
Sheets("Measures").Range("H7:H23").Copy
Range("E7:E23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
' Change the date for new day
Sheets("Sheet1").Range("B11").Copy
Sheets("Measures").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Le probleme c ke le dernier enregistrement de ma premiere table ne s'affiche pa et je asi pa prkoi
Les commentaires sont en anglais parceke mon stage est au usa ;)
en tt cas merci bcp

21/04/2006, 00h06
Vesta

ce n'est pas du au
Do While r < 24

ce ne devrait pas etre
Do While r <= 24
21/04/2006, 01h13
AlainTech

Citation:

Envoyé par virtualinsanity

en fait la jsui en stage de fin d'etudes et la boite pr ki je fai ca ils bossent tt le tps ac excel (veulent pa change) et les operateurs ne savent pas utiliser access (et ne l'ont pa sur leurs postes) dc jsui obligee de le faire sur excel. et kom je doi faire un archivage et ke eux le faisai sur excel!!! je me sui di autan le faire sur access et faire des formulaires pr consulation des archive pr les manager (ki eux ont access)

Prière d'écrire correctement!
Un forum n'est pas un portable!
http://club.developpez.com/regles/#L4.3
21/04/2006, 16h40
virtualinsanity

Je m'excuse de ne pas avoir bien ecrit
ensuite si je ne reponds pas en temps voulu c'est parceque je suis a l'autre bout du globe, je suis au etats unis et donc je reponds avec un certain decalage.
Pour te repondre vesta (et merci de m'aider), ca n'avais rien avoir avec le Do While r < 24
En fait comme j'utilise un recordset, il faut qu'a la fin de ma bouble j'ajoute ca:
'dans la boucle with
.Update
End With
r = r + 1 'Next Row
Loop
'fermer et vider le recordset
rs.Close
Set rs = Nothing
voila merci pour tout ;)
21/04/2006, 17h20
Vesta

ok c'est résolu alors...
21/04/2006, 17h27
virtualinsanity

oui c'est resolu finalement sauf que maintenant je recois un type mismatch sur une partie du code qui s'executait normalement mais bon je vais trouver l'erreure en tout cas merci de m'avoir repondu bonne journee (ou fin de journee)