Problème avec DoCmd.RunSavedImportExport

**Almeyric** · 21/10/2014, 23h46

Bonsoir,

J'ai récupéré la maintenance de BDD d'une association. Hors celle-ci pose beaucoup de soucis, je dois refaire le développement complet que j'ai commencé sous 2013. Cette base sert à gérés des personnes âgés accueillis chez des familles d'accueilles et à générer les bulletins tous les mois. Hors là, il y a un gros problème plus moyen d'éditer un bulletin. Je vous explique le fonctionnement actuel dont j'ai eu beaucoup de mal à comprendre...

Dans un formulaire, on affiche la personne âgés avec son accueillant, on lance une macro par un bouton pour accéder au formulaire détail de l'accueillant. Jusque là, çà va. En étant, sur le formulaire de l'accueillant, on peut lancer le processus pour créer le bulletin sous excel avec du VBA. Mais avant d'arriver sous excel, la commande exécute ceci :

Code :

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

1
2
3
4
5
6
7
Private Sub Accéder_aux_Bulletins_de_Salaires_Click()
    DoCmd.OpenForm "Détails de l'Accueillant Familial", acNormal, "", "[Accueillants Familiaux]![ID]=[Forms]![Détails de l'Accueillant Familial]![ID]", , acHidden
    DoCmd.DeleteObject acTable, "Liste Accueillants Remplaçants"
    DoCmd.OpenQuery "Liste Accueillants Remplaçants Requete Création", acViewNormal, acAdd
    DoCmd.OpenQuery "Liste Accueillants Remplaçants Requete Ajout", acViewNormal, acAdd
    DoCmd.RunSavedImportExport "Exportation-Liste Accueillants Remplaçants"
    'Call Macro3

Donc ici, on sélectionne les données de l'accueilli et de l'accueillant qui sont stockés dans une table de la base pour être exporté dans Liste Accueillants Remplaçants. Hors j'ai Access qui rale avec l'erreur d'exécution 2302 : Access ne peut pas enregistrer les résultats dans le fichier que vous avez sélectionné.

Alors, il n'y a que l'extension xls qui n'est pas indiqué mais ça fonctionnez avant.... Le fichier a beau être présent est vierge cela revient au même.

_________

Ensuite, on vérifie si le fichier existe ou pas. Puis supprime le fichier créer ci-dessous. J'avoue que je m'y perds un peu.

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
    Dim Path As String
    Path = "Z:\BULLETINS DE SALAIRES\"
 
    Dim Bulletin As String
    Bulletin = "Z:\BULLETINS DE SALAIRES\BULLETIN DE SALAIRE.xlsm"
 
    Dim nomfichier As Variant
    nomfichier = Forms![Détails de l'Accueilli Simple]![ID Accueilli simple]
    nomfichier = nomfichier * 1
    Dim MonExcel As New Excel.Application
    MonExcel.Visible = True
    On Error GoTo toto:
    'MonExcel.Workbooks.Open FileName:=Path & nomfichier & ".xlsm"
    MonExcel.Workbooks.Open "Z:\BULLETINS DE SALAIRES\" & nomfichier & ".xlsm"
    GoTo tata
toto:
    MonExcel.Workbooks.Add "Z:\BULLETINS DE SALAIRES\BULLETIN DE SALAIRE.xlsm"
tata:
End Sub

Dans le fichier Bulletin de salaire, on ouvre un fichier qui se nomme : Liste Accueillants Remplaçants.xls

Voici le code dans le XLSM qui fait référence au fichier et action éffectué :

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
Private Sub Workbook_Open()

    Sheets("MENU").Select
    ActiveWindow.WindowState = xlMaximized
    Range("A1:H19").Select
    Range("H19").Activate
    ActiveWindow.ZOOM = True
    Range("Z100").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.WindowState = xlMinimized

    Sheets("DONNEES").Select
        Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents

    Sheets("DONNEES EMPLOYES").Select
        Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents

    Sheets("DONNEES CALCUL").Select
    
    Range("A1:B2,C1:H5,I1:DZ422").Select
    Range("I1").Activate
    ActiveWindow.ScrollColumn = 1
    Selection.ClearContents
    Range("A1").Select

    Sheets("DONNEES CALCUL EMPLOYES").Select
    
    Rows("1:2").Select
    Range("D1").Activate
    Range("1:2,BR:IV").Select
    Range("BR1").Activate
    Selection.ClearContents
    Range("C3:D4").Select
    Range("D4").Activate
    Selection.ClearContents
    Range("A1").Select
    
    
    
        Workbooks.Open Filename:= _
        "Z:\Liste Accueillants Remplaçants.xls"
    
    Dim NUMERO As String
    NUMERO = Range("A2").Value
    NUMERO = NUMERO * 1 <-- Pour moi, je trouve que cela ne sert à rien, mais je ne suis pas un expert du dv sous vba que ce soit pour access et excel

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
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
Range("A1:AC2").Select
    Selection.Copy
 
    ActiveWindow.ActivateNext
    Sheets("DONNEES CALCUL").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=5
 
    Sheets("DONNEES CALCUL EMPLOYES").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=5
 
    ActiveWindow.ActivateNext
 
    'Sheets("DONNEES CALCUL").Select
    Range("A1:EO20").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ActivateNext
 
 
    Sheets("DONNEES CALCUL").Select
    Range("AD1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Z:Z").Select
    ActiveWindow.ScrollColumn = 1
 
    Sheets("DONNEES CALCUL EMPLOYES").Select
    Range("A1:BO200").Select
    Range("AD1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Z:Z").Select
 
 
    ActiveWindow.ActivateNext
    Application.DisplayAlerts = False
    ActiveWindow.Close SaveChanges:=False
 
 
    Dim file
    Dim fs
    Dim f
    Dim NoLIGNE
    Dim E3
    Dim D3
 
 
    file = "Z:\Liste Accueillants Remplaçants.xls"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(file)
    If f Is Nothing Then
    GoTo ende
    Else
    f.Delete
    End If
 
ende:
        ChDir "Z:\BULLETINS DE SALAIRES"
    ActiveWorkbook.SaveAs Filename:= _
        "Z:\BULLETINS DE SALAIRES\" & NUMERO & ".xlsm", FileFormat _
        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Windows(NUMERO & ".xlsm").Activate
finir:
    Sheets("DONNEES CALCUL").Select
    Columns("BG:BG").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Select
Dim NoLIGNEC
Dim D33
Dim E33
 
    NoLIGNE = ActiveCell.Row
    D33 = NoLIGNE - 3
    Range("D3").Value = D33
    Range("E3").Value = "REMPLACANT(S)"
    Range("D3").Select
 
    Sheets("DONNEES CALCUL EMPLOYES").Select
    Range("D3").Value = D33
    Range("E3").Value = "EMPLOYES(S)"
 
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Columns("E:E").Select
    Selection.ColumnWidth = 36.86
    Cells.Select
    Cells.EntireRow.AutoFit
 
 
    Sheets("DONNEES CALCUL").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Columns("E:E").Select
    Selection.ColumnWidth = 36.86
    Cells.Select
    Cells.EntireRow.AutoFit
 
    Cells.Select
    Selection.Copy
    Sheets("DONNEES").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
 
    Sheets("DONNEES CALCUL EMPLOYES").Select
    Cells.Select
    Selection.Copy
    Sheets("DONNEES EMPLOYES").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
 
FININIT:
    Workbooks.Open Filename:= _
        "Z:\BULLETINS DE SALAIRES\TAUX BULLETINS.xlsx" _
        , UpdateLinks:=3
    Cells.Select
    Selection.Copy
    ActiveWindow.ActivateNext
    ActiveWindow.WindowState = xlNormal
    Sheets("TAUX").Select
    Cells.Select
    Application.DisplayAlerts = False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.ActivateNext
    ActiveWorkbook.Save
    ActiveWindow.Close
 
Call ZOOM
 
    ActiveWindow.WindowState = xlMaximized
 
 
End Sub

Là, j'ai vraiment besoin d'aide, car mon amie a pratiquement 200 bulletins de paies à éditer pour ce mois. Hors de question de lui faire défaut.

Merci à tous ceux qui pourront m'aider.

**Almeyric** · 22/10/2014, 16h56

Bonjour,

Nous avons trouvé le problème avec un collègue ce jour.

En faite, comme il utilisé l'assistant, les chemins n'étaient plus bon. Il ne me restera plus qu'à remettre cela au propre avec chemin à la racine.

Problème avec DoCmd.RunSavedImportExport [AC-2007]

VBA Access

Discussions similaires

Partager

Partager