Bonjour à tous,
J'ai créé une base Access 2010 qui écris sur un fichier excel des lignes d'une table Access et j'ai de temps en temps cette erreur :
"la méthode Range de l'objet '_Global' a échoué" erreur 1004 sur cette procédure : ligne 58
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
 
Public Sub ProcExportExcel(onglet)
Dim xlApp As Excel.Application 'Appli Excel
Dim oWkb As Excel.Workbook 'Classeur
Dim oWSht As Excel.Worksheet  'Feuille de Calcul
Dim Cell As Range
Dim ligne As Long
Dim col1 As Integer
Dim col2 As Integer
Dim col3 As Integer
Dim col4 As Integer
Dim col5 As Integer
Dim lignetrouvee, mc As Range
Dim bd As DAO.Database
Set bd = CurrentDb
Dim RecSet As DAO.Recordset
Dim cSQL As String
Dim NumInsert As String
Dim NumInsertCell As Range
Dim Num_Arch As String
Dim V_ADRESS_DOSS As String
Dim DM As String
Dim Empl As String
Dim ind_onglet As Variant
Dim Choix_ligne As String
Dim Num_ligne As Integer
Dim Msg As String
Dim Title As String
Dim Response
Dim Rep As Boolean
Dim Style As Variant
Dim Adre As String
Dim NonVide As Range
Set xlApp = CreateObject("Excel.Application")
 
cSQL = "SELECT N°Insertion,NUM_Archives,Adress_Doss, TAB_DM.DM,TAB_DM.EMPLACEMENT " & _
"FROM TAB_INSERTIONS INNER JOIN TAB_DM ON TAB_INSERTIONS.DM = TAB_DM.DM " & _
"WHERE Tab_DM.DM ='" & Forms!F_Ges_DM!Liste9 & "'" & "" & _
"ORDER BY Tab_Insertions.Date_Trait DESC,Tab_Insertions.N°Insertion;"
Set RecSet = bd.OpenRecordset(cSQL)
With xlApp
Set oWkb = xlApp.Workbooks.Open(DLookup("[Chemin_Fichier_Export]", "TAB_PARAMETRE") & DLookup("[Nom_Fichier_Export]", "TAB_PARAMETRE"))
For Each oWSht In oWkb.Sheets
          If oWSht.Name = onglet Then
            ind_onglet = oWSht.index
            Exit For
          End If
            Next
On Error GoTo Ges_Err
ligne = 2
col1 = 1
col2 = 2
col3 = 3
col4 = 4
col5 = 5
Num_ligne = 2
Choix_ligne = "A" & Num_ligne & ":E" & Num_ligne & ""
Set NonVide = Worksheets(1).Range("G1")
RecSet.MoveFirst
With Worksheets(1).Range("A2:A2000")
 
  If NonVide.Value > 0 Then
      Msg = "Le Fichier d'Export est déjà utilisé. Voulez-vous continuer ?"
      Style = vbYesNo + vbQuestion + vbDefaultButton1
      Title = "Export Excel "
  '    Response = MsgBox(Msg, Style, Title)
      If Not Rep Then Response = MsgBox(Msg, Style, Title)
        Rep = True
      End If
End With
Do While Not RecSet.EOF
If IsEmpty(Response) Or Response = vbYes Then
          NumInsert = RecSet.Fields("N°Insertion")
          Num_Arch = RecSet.Fields("NUM_Archives")
          If Not IsNull(RecSet.Fields("Adress_Doss")) Then
            V_ADRESS_DOSS = RecSet.Fields("Adress_Doss")
          End If
          DM = RecSet.Fields("DM")
          Empl = RecSet.Fields("Emplacement")
    With ActiveSheet
             oWSht.Cells(ligne, col1).Select
             oWSht.Cells(ligne, col1).Value = NumInsert
             oWSht.Cells(ligne, col2).Select
             oWSht.Cells(ligne, col2).Value = Num_Arch
             oWSht.Cells(ligne, col3).Select
             oWSht.Cells(ligne, col3).Value = V_ADRESS_DOSS
             oWSht.Cells(ligne, col4).Select
             oWSht.Cells(ligne, col4).Value = DM
             oWSht.Cells(ligne, col5).Select
             oWSht.Cells(ligne, col5).Value = Empl
       End With
         ligne = ligne + 1
          Num_ligne = Num_ligne + 1
          Choix_ligne = "A" & Num_ligne & ":E" & Num_ligne & ""
          If Not RecSet.EOF Then
            RecSet.MoveNext
          End If
      Else
   RecSet.MoveNext
 End If
Loop
If IsEmpty(Response) Or Response = vbYes Then
  MsgBox "Export réussi... ", _
     vbOKOnly, _
     "Export Excel "
End If
' Sauvegarder et fermer le classeur
        oWkb.Save
        oWkb.Close
' Quitter Excel
        .Quit
' Libérer les variables objet
    Set oWSht = Nothing 'Feuille de Calcul
    Set oWkb = Nothing   'Classeur
    Set xlApp = Nothing  'Excell
FinGes_err:
  Exit Sub
Ges_Err:
    If err = 9 Then MsgBox "Attention ! Onglet " & onglet & " n'existe pas dans le fichier Export Prière d'en informer les Référents  ", _
     vbOKOnly + vbCritical, _
     "Export Excel "
MsgBox err.Description & " " & err.Number
       ' Sauvegarder et fermer le classeur
       If err <> 1004 Then
        oWkb.Save
       End If
       If err <> 462 Then
        oWkb.Close
       End If
       ' Libérer les variables objet
       ' Quitter Excel
        .Quit
    End With ' Libérer les variables objet
      Set oWSht = Nothing 'Feuille de Calcul
      Set oWkb = Nothing   'Classeur
      Set xlApp = Nothing  'Excell
      Resume FinGes_err
End Sub
Si quelqu'un a une idée Merci