probleme pour supprimer une feuille excel

**sebing** · 23/11/2012, 14h09

Bonjour,

Avec les codes trouvés à droites à gauche (merci de vos participations

), j'essaye de faire une exportation des données d'access sous excel.
Comme il risque d'avoir des mises à jour, je pensais supprimer ma feuille et la recréer, mais ma feuille ne se supprime pas

En vrai elle se supprime une fois et apres si je relance le code ça ne marche pas, je ferme Access et je le reouvre ça fonctionne mais qu'une fois.
Comment faire pour que ça fonctionne a chaque fois et que l'on soit pas obliger de fermer une application?
Je vous donne le code que je suis en train d'ecrire et qui ne marche pas (mes lignes de suppressions sont ligne 41 à 46:

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
Sub ExportDsMemeClasseur()
 '
' Remarque:
' Utilise fonction IsFileOpen(...) de la FAQ Access
' Source : http://access.developpez.com/faq/?page=InformationsRep#estFicOuvert
'
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim I As Long, J As Long
    Dim t0 As Long, t1 As Long
    Dim rec As DAO.Recordset
    Dim sFichierExcel As String, sNomFeuille As String
    Dim bFichierExiste As Boolean
    Dim datemois As String
    Dim datean As Integer
    Dim FeuilleExiste As Boolean
    ' Initialisations variables creer un fichier excel par année
    datean = Forms![F_Planning].An.Value
    sFichierExcel = "T:\Documents\gardes_st_" & datean & ".xlsx"
    datemois = Format("01/" & Forms![F_Planning].Mois.Value & "/" & Year(Now()), "mmmm")
    sNomFeuille = datemois & " " & datean
    t0 = Timer
 
    ' Le fichier existe-t-il et est-il libre ?
    bFichierExiste = False
    If Len(Dir(sFichierExcel, vbNormal)) > 0 Then
       bFichierExiste = True
       ' Si fichier ouvert, afficher un message et sortir
       If IsFileOpen(sFichierExcel) Then
          MsgBox "Veuillez fermer le fichier '" & sFichierExcel & "'  SVP"
          Exit Sub
       End If
    End If
 
    ' Initialisations Excel
    Set xlApp = CreateObject("Excel.Application")
    ' Si le fichier existe on l'ouvre
    If bFichierExiste Then
       Set xlBook = xlApp.Workbooks.Open(sFichierExcel)
'verifie si la feuille existe, si oui on la supprime
        For Each xlSheet In xlBook.Sheets
            If xlSheet.Name = sNomFeuille Then
                xlBook.Worksheets(sNomFeuille).Delete
            End If
        Next
' Sinon on le crée
    Else
       Set xlBook = xlApp.Workbooks.Add
       ' Ne conserver que la première feuille
       For I = xlBook.Worksheets.Count To 2 Step -1
           xlBook.Worksheets(I).Delete
       Next
    End If
 
 
  ' Ajouter une feuille de calcul au classeur existant
    ' ou référencer la 1ère feuille du nouveau classeu
    If bFichierExiste Then
       Set xlSheet = xlBook.Worksheets.Add
    Else
       Set xlSheet = xlBook.Worksheets(1)
    End If
 
    ' Renommer la feuille
    xlSheet.Name = sNomFeuille
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Garde " & sNomFeuille
 
    ' Ouverture recordset sur données à exporter
    Set rec = CurrentDb.OpenRecordset("SELECT * FROM novembre", dbOpenSnapshot)
 
    ' les entetes
    '  .Fields(Index).Name renvoie le nom du champ
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(2, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
    Next J
 
    ' recopie des données à partir de la ligne 3
    I = 3
    Do While Not rec.EOF
        For J = 0 To rec.Fields.Count - 1
            ' .Fields(Index).Type renvoie le type du champ
            '   si c'est un Texte (dbText) nous insérons "'" pour
            '   qu'il soit reconnu par Excel comme du Texte
            If rec.Fields(J).Type = dbText Then
                xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
            Else
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
            End If
        Next J
        I = I + 1
        rec.MoveNext
    Loop
 
    ' Fermeture et libération recordset
    rec.Close
    Set rec = Nothing
 
    ' code de fermeture et libération des objets Excel
    If bFichierExiste Then
      ' Le classeur existait déjà. On le sauve
       xlBook.Save
    Else
      ' Enregistrement du nouveau classeur
       xlBook.SaveAs sFichierExcel
    End If
    Set xlSheet = Nothing
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
 
    t1 = Timer
    Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"
End Sub

J'ai appenté le net et essayé plusieurs méthodes mais rien n'y fait

Pouvez vous me dire ou est mon erreur SVP.

Je vous en remercie par avance

Seb

**tee_grandbois** · 24/11/2012, 17h35

Bonjour,
ton problème est que tu veux supprimer une feuille unique (car le code supprime les autres feuilles).
Donc, plutôt que de supprimer la feuille et la recréer, il vaut mieux vider le contenu de toutes les cellules avec la méthode ClearContents :

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
Sub ExportDsMemeClasseur()
 '
' Remarque:
' Utilise fonction IsFileOpen(...) de la FAQ Access
' Source : http://access.developpez.com/faq/?page=InformationsRep#estFicOuvert
'
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim I As Long, J As Long
    Dim t0 As Long, t1 As Long
    Dim rec As DAO.Recordset
    Dim sFichierExcel As String, sNomFeuille As String
    Dim bFichierExiste As Boolean
    Dim datemois As String
    Dim datean As Integer
    Dim FeuilleExiste As Boolean
    Dim FinCell As Integer
 
    ' Initialisations variables créer un fichier excel par année
    datean = Forms![F_Planning].An.Value
    sFichierExcel = "T:\Documents\gardes_st_" & datean & ".xlsx"
 
    datemois = Format("01/" & Forms![F_Planning].Mois.Value & "/" & Year(Now()), "mmmm")
    sNomFeuille = datemois & " " & datean
    t0 = Timer
 
    ' Le fichier existe-t-il et est-il libre ?
    bFichierExiste = False
    If Len(Dir(sFichierExcel, vbNormal)) > 0 Then
       bFichierExiste = True
       ' Si fichier ouvert, afficher un message et sortir
       If IsFileOpen(sFichierExcel) Then
          MsgBox "Veuillez fermer le fichier '" & sFichierExcel & "'  SVP"
          Exit Sub
       End If
    End If
 
    ' Initialisations Excel
    Set xlApp = CreateObject("Excel.Application")
 
    ' Si le fichier existe on l'ouvre
    If bFichierExiste Then
       Set xlBook = xlApp.Workbooks.Open(sFichierExcel)
' On vérifie si la feuille existe, si oui on vide les cellules
        For Each xlSheet In xlBook.Sheets
            If xlSheet.Name = sNomFeuille Then
                xlSheet.Activate
                FinCell = xlSheet.Range("A65536").End(xlUp).Row
                xlSheet.Cells.Range("A1:A" & FinCell).EntireRow.ClearContents
            End If
        Next
' Sinon on la crée
    Else
       Set xlBook = xlApp.Workbooks.Add
       ' Ne conserver que la première feuille
       For I = xlBook.Worksheets.Count To 2 Step -1
           xlBook.Worksheets(I).delete
       Next
    End If
 
    ' Définit la feuille de calcul
       Set xlSheet = xlBook.Worksheets(1)
 
    ' Nommer la feuille
    xlSheet.Name = sNomFeuille
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Garde " & sNomFeuille
 
    ' Ouverture recordset sur données à exporter
    Set rec = CurrentDb.OpenRecordset("SELECT * FROM novembre", dbOpenSnapshot)
 
    ' les entetes
    '  .Fields(Index).Name renvoie le nom du champ
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(2, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
    Next J
 
    ' recopie des données à partir de la ligne 3
    I = 3
    Do While Not rec.EOF
        For J = 0 To rec.Fields.Count - 1
            ' .Fields(Index).Type renvoie le type du champ
            '   si c'est un Texte (dbText) nous insérons "'" pour
            '   qu'il soit reconnu par Excel comme du Texte
            If rec.Fields(J).Type = dbText Then
                xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
            Else
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
            End If
        Next J
        I = I + 1
        rec.MoveNext
    Loop
 
    ' Fermeture et libération recordset
    rec.Close
    Set rec = Nothing
 
    ' code de fermeture et libération des objets Excel
    If bFichierExiste Then
      ' Le classeur existait déjà. On le sauve
       xlBook.Save
    Else
      ' Enregistrement du nouveau classeur
       xlBook.SaveAs sFichierExcel
    End If
    Set xlSheet = Nothing
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
 
    t1 = Timer
    Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"
End Sub

**sebing** · 24/11/2012, 18h16

Bonsoir,

Merci beaucoup pour l aide apportée

J essaye le code lundi et je reviens vous tenir au courant( et mettre résolu

)
Merci encore
Bonne soirée et bon week end
Seb

**Djim33** · 25/11/2012, 23h44

l'autre solution consiste à créer une nouvelle feuille, supprimer l'ancienne, puis renommer la nouvelle avec le bon nom.

**sebing** · 27/11/2012, 14h17

Merci beaucoup pour vos aides

Voici la partie du code que j'ai mis afin de mettre a jour mon classeur

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
' verifie si la feuille existe
        Dim f As Object
        On Error Resume Next
        Set f = xlBook.Worksheets(sNomFeuille)
        If err = 0 Then
                xlBook.Worksheets.Add
                xlBook.Worksheets(sNomFeuille).Cells.ClearContents
                xlApp.Application.DisplayAlerts = False
                xlBook.Worksheets(sNomFeuille).Delete
                xlApp.Application.DisplayAlerts = True
        Else
              xlBook.Worksheets.Add
        End If
    Else
        Set xlBook = xlApp.Workbooks.Add

Merci encore bonne journée

seb

probleme pour supprimer une feuille excel [AC-2010]

VBA Access

Discussions similaires

Partager

Partager