Discussion :

[celiaaa]

Bonjour à tous,

j'ai un problème qui dure depuis plusieurs et j'avoue être à court d'idées..

j'exporte des données d'un recordset avec access sur excel de cette façon:

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


  Set db = DBEngine.OpenDatabase(MA_BASE_ACCESS)
          
    'J'initialise mes variables
    Set xlApp = CreateObject("Excel.Application")
    'Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path + "\titre.xls")
     Set xlWb = xlApp.Workbooks.Add
     
    If xlApp Is Nothing Then
        MsgBox "Impossible d'ouvrir excel"
        Exit Sub
    End If
    
    xlApp.DisplayAlerts = False
sql = " SELECT   var1,var2, var3......,  FROM table1,table2, ENTITE,..."
    
   
        
    rs.Open sql, CurrentProject.Connection, adOpenDynamic, adLockPessimistic
    
    
     xlSheet.Range("A2:K2").Select
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = True
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
      xlSheet.Range("A2:K2").Select
      ActiveCell.FormulaR1C1 = "FICHE  " & rs.Fields(0) & ""
    
       
    
      
     'Quadriller
    xlSheet.Range("A4:K13").Select
    xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    
     With xlApp.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With xlApp.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
           
    
    'mettre les en-tête
    rs.MoveFirst
    While Not rs.EOF
        
        For j = 3 To 11
        'mettre les libellés
            xlSheet.Cells(j + 1, 1) = rs.Fields(j - 2).name
            xlSheet.Range("B" & j + 1, "K" & j + 1).Select
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = True
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
        xlSheet.Range("B" & j + 1, "K" & j + 1).Select
        
        If IsDate(rs.Fields(j - 2)) Then
             
            ActiveCell.FormulaR1C1 = Format(rs.Fields(j - 2), "dd/mm/yyyy")
        Else
               'ActiveCell.FormulaR1C1 = rs.Fields(j - 2)
               ActiveCell.FormulaR1C1 = "REST"
              
        End If
        Next
        j = j + 1
         rs.MoveNext
    Wend

Au premier clique de mon bouton, tout se passe bien ,j'exporte correctement mes données.
Supposons que je reclique sur le bouton, un nouveau classeur s'ouvre et les données en orange (provenant de monr ecordset)ne s'affiche plus du tout...
pourtant quand je suis en mode debuggage ou que j'entre en dur une valeur, les données sont bien présente mais ne s'affiche pas sur Excel.....

De plus , si je ferme mon formulaire et que je reouvre pour exporter sur excel à nouveau les mêmes données, ça plante sur la ligne en rouge..
Je comprends vraiement pas!

merci pour votre aide.

[mouaa]

essaye de vider tes variables à la fin de ton code:

Code :

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

1
2
rst.close
'et les autres aussi

si tu es chanceux ça fonctionnera

[celiaaa]

Merci mouaaa d'avoir pris le temps de regarder mon post.
Apparement la chance n'est pas avec moi, car les recordsets sont (correctement) fermés et tout mes processus (xlapp...) sont nothing..

[mouaa]

arf.... alors là je vois pas...

essaye de voir si en rechargement ton formulaire ça fonctionne mieux on sait jamais ça pourrait faire comme si on fermait puis rouvrait tout....

[celiaaa]

Je vais essayer de suivre ta piste.
Mais qu'entends par rechargement?

Merci pour ton aide

[DMboup]

...et tout mes processus (xlapp...) sont nothing..

les processus doivent être fermés et non mis à nothing.
Si le classeur et ouvert et que tu essaie de l'ouvrir à nouveau ce sera un fichier en lecture seul que tu aura.

Il faut soit fermer excel après une exportation, soit sauter la partie ouverture aux futures clic (ceux >1).

Voila.

[mouaa]

la solution de DMboup me semble bien, mais si tu veux savoir ce que j'entends pas reload pour info c'est un truc du style

Code :

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

Me.Refresh

[celiaaa]

Merci pour vos conseils!

Mboup quand tu parles de sauter la partie ouverture aux futures clic (ceux >1), tu entends par là de sauter la partie

Code :

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

Set xlApp = CreateObject("Excel.Application")?

Je ne fais pas de close et de quit car en fait je veux qu'à chaque clique d'un bouton, un nouveau classeur se créé avec des données provenant en partie d'un recordset..

merci bien