[XL-2002] Message "Pour éviter la perte de données.." apres un RefreshStyle par macro

Bonjour,

J'ai 2 feuilles dans un fichier Excel qui contiennent une requête analyse croisée différente pour chacune provenant d'une base Access.

Les 2 feuilles sont insérées par 2 boutons différents dans Access.
Les boutons sont programmés par un code quasiment identique. Voici l'exempel du bouton 1:

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
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
Private Sub Commande1_Click()
 
    Dim TQName As String
    Dim xlQryTbl As Excel.QueryTable
    Dim sODBCconn As String, sSQL As String
    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim Annee As Variant
    Dim NomFichier As Variant
    Annee = Me![Num Année]
    NomFichier = "2onglets.xls"
 
    If Me.Dirty Then
    DoCmd.RunCommand acCmdSaveRecord
    End If
 
    ' Démarrer Excel et le rendre visible
 
    Set xl = CreateObject("Excel.Application")
    Set wbk = xl.Workbooks.Open("C:\" & NomFichier, 0)
    xl.Visible = True
    'On Error Resume Next
    xl.UserControl = True
 
    ' Test de l'existence d'une feuille
    If FeuilleExiste(wbk, "S1 " & "." & Annee & " ") Then
       'Fermer le classeur sans l'enregistrer
       wbk.Close False
       Set wbk = Nothing
 
       ' Quitter Excel
       xl.Quit
       Set xl = Nothing
 
       MsgBox "La feuille S1 " & "." & Annee & " existe deja.", vbInformation
 
    Else
 
       ' Créer une nouvelle feuille après la dernière feuille
       Set xlSheet = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
       xlSheet.Name = "S1 " & "." & Annee & " "
       xlSheet.Activate
 
       ' Chaîne de connexion ODBC
       sODBCconn = "ODBC;DSN=MS Access Database;" & _
                   "DBQ=d:\Documents and Settings\2594215\Bureau\William AF\test william\TESTen coursMennecyAmeliore 12_08.mdb"
       ' Code SQL de la requête
       sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]='MAN',1,IIf([R_QueryTableaupresent 1S].[Expr1]='TECH',2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]='M',1,IIf([R_QueryTableaupresent 1S].[Horaire1]='S',2,3));"
 
       ' Nom requête Excel
       TQName = "TQ_" & "S1" & "_" & Annee
 
       ' Supprime définitions de requêtes autres que TQName
       SupprLiaisonsTQ wbk, TQName
 
       ' Demarre la requete ajout
       DoCmd.RunMacro "M3 Horrairemystere.Rempliossage horraire disvié"
 
       ' Création requête Excel
       Set xlQryTbl = wbk.ActiveSheet.QueryTables.Add(sODBCconn, wbk.ActiveSheet.Range("A3"))
 
       'Paramétrage requête Excel
       With xlQryTbl
           .CommandText = sSQL
           .Name = TQName
           .FieldNames = True
           .RowNumbers = False
           .FillAdjacentFormulas = False
           .PreserveFormatting = True
           .RefreshOnFileOpen = False
           .BackgroundQuery = False
           .RefreshStyle = xlOverwriteCells
           .SavePassword = True
           .SaveData = True
           .AdjustColumnWidth = True
           .RefreshPeriod = 0
           .PreserveColumnInfo = True
       End With
       ' Exécute requête
       xlQryTbl.Refresh False
 
    xlSheet.Range("C1").Formula = "=INT(MOD(INT((C3)/7)+0.6,52+5/28))+1"
    xlSheet.Range("C1").AutoFill xlSheet.Range("C1:GB1"), xlFillCopy
 
    xlSheet.Range("C2").Formula = "=TEXT(C4, ""jjj"")"
    xlSheet.Range("C2").AutoFill xlSheet.Range("C2:GB2"), xlFillCopy
 
       wbk.Save
 
       Set xlQryTbl = Nothing
       Set xlSheet = Nothing
       wbk.Close
       Set wbk = Nothing
       xl.Quit
       Set xl = Nothing
 
    End If
 
End Sub

Evidemment, j'aimerai que ces feuilles s'actualisent en même temps que les modifications faites sur Access. Pour cela j'ai crée un module que j'apelle sur un bouton (que l'utilisateur Access clique apres avoir fait des modifications)

Voici le module:

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
Sub SupprLiaisonsTQ(xlWbk As Excel.Workbook, sSaufTQName As String)
Dim xlSheet As Excel.Worksheet
Dim sSaufTQName2 As String
Dim sTQName As String, bDeleteQuery As Boolean
Dim i As Integer
 
' Détermine le nom de la requête Excel pour la période précédente.
' ex : si sSaufTQName = "TQ_S1_12" -> TQ_S2_11
'      si sSaufTQName = "TQ_S2_12" -> TQ_S1_12
If sSaufTQName Like "TQ_S1_##" Then
   sSaufTQName2 = "TQ_S2_" & Format(CLng(Mid(sSaufTQName, 7, 2)) - 1, "00")
ElseIf sSaufTQName Like "TQ_S2_##" Then
   sSaufTQName2 = "TQ_S1_" & Mid(sSaufTQName, 7, 2)
End If
 
' Parcourir les feuilles
For Each xlSheet In xlWbk.Worksheets
    ' Parcourir les requêtes Excel
    For i = xlSheet.QueryTables.Count To 1 Step -1
        sTQName = xlSheet.QueryTables(i).Name
        ' Si c'est une requête TQ_Sn_AA
        If sTQName Like "TQ_S#_##" Then
           bDeleteQuery = True
           If (sTQName = sSaufTQName) Then bDeleteQuery = False
           If (sTQName = sSaufTQName2) Then bDeleteQuery = False
           If bDeleteQuery Then
              xlSheet.QueryTables(i).Delete
           End If
        End If
    Next
Next
 
End Sub

Le bouton 2 crée la feuille nommée "S2. XX" et le bouton 1 crée "S1. XX" (S correspond au semestre de l'année et XX à l'année)

Le problème:
Quand je crée par exemple "S2. 12" et juste après "S1. 13" alors au moment de l'actualisation j'ai ce message d'erreur qui apparait:

"...Pour éviter la perte possible de données, Microsoft Excel ne peut pas déplacer les cellules non vides hors de la feuille de calcul..."

Quand je clique sur OK (pas le choix), les valeurs de la requete de "S2. 12" uniquement bug et s'efface :s tandis que la "S1. 13" s'actualise normalement.

Quelqu'un sait pourquoi?
(désolé si le message est un peu long mais c'est pas évident d'expliquer par écris)

Merci pour votre aide,
Will