[VBA] Gros problème avec access et Excel

Version imprimable

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:

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. :cry:

08/08/2007, 09h21
mouaa
essaye de vider tes variables à la fin de ton code:
Code:

1 2 rst.close 'et les autres aussi
si tu es chanceux ça fonctionnera
08/08/2007, 10h27
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..

:cry:
08/08/2007, 11h42
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....
08/08/2007, 11h55
celiaaa

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

Merci pour ton aide
08/08/2007, 13h10
DMboup

Citation:

Envoyé par celiaaa

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

:cry:

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.
08/08/2007, 13h18
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:

Me.Refresh
08/08/2007, 14h31
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:

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
08/08/2007, 14h36
DMboup

Citation:

Envoyé par 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:

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

C'est bien ca.
08/08/2007, 14h53
celiaaa

Je n'arrive pas trop à saisir (désolais)

Si je saute cette ligne (quand le nombre de clique du bouton dépasse un), je ne voie pas comment je peux créer un classeur sachant que je le créé grâce à un add avec

Code:

xlApp. Set xlWb = xlApp.Workbooks.Add

Si j'enlève cette ligne je ne peux pas afficher un nouveau classeur?!!!
Je dois avoir mal compris...

Merci
08/08/2007, 15h06
DMboup
Citation:

Envoyé par celiaaa

Je dois avoir mal compris...

Non ce sont les lignes que tu mélange.

Ce qu'il faut sauter, c'est la recréation de l'objet xlApp
Code:

1 2 Set xlApp = CreateObject("Excel.Application")
Par contre cette ligne ci-dessous reste.
Code:

1 2 Set xlWb = xlApp.Workbooks.Add
PS : xlApp (L'object Excel) <> xlWb (Le classeur)

J'ai essayer mais il ne veut pas ajouter un classeur.
Ca plante sur

Code:

Set xlWb = xlApp.Workbooks.Add

et ça m'écris variable objet ou variable de bloc with non définie

Et cela vient du fait que j'ai enlevé le xApp...

voila mon code..peu être que j'ai fait une bourde mais je ne vois pas
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Set db = DBEngine.OpenDatabase(MA_BASE_ACCESS) 'J'initialise mes variables Set xlApp = CreateObject("Excel.Application") if nbClic=1 then Set xlWb = xlApp.Workbooks.Add end if If xlApp Is Nothing Then MsgBox "Impossible d'ouvrir excel" Exit Sub End If xlApp.DisplayAlerts = False
La variable nbClic est incrémenté à chaque clique d'un bouton...
Elle vaut donc 1 à l'initial

Merci

08/08/2007, 16h10
DMboup

Désolé; Tu ne regardes pas bien ce que je proposes.

La création du classeur doit se faire tout le temps.

C'est l'initialisation de l'application qui doit se faire une seule fois "Set xlApp = CreateObject("Excel.Application")"

Ne te précipites pas. Relis calmement les posts du dessus.

Oui pardon c'est bien ce que j'avais fait sur mon code (j'ai fait un copié collé du dessus et ajouter sur le poste le nb>1 , j'ai mal regardé donc je les mis sur le workbook)

Voila ce que j'ai fais mais j'ai tjsr l' erreur variable objet ou variable de bloc with non définie
J'ai peut -être mal initialisé des variables..
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 Dim xlApp As Excel.Application Dim xlWb As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim xlBook As Excel.Workbook Set db = DBEngine.OpenDatabase(MA_BASE_ACCESS) if nbClic=1 then Set xlApp = CreateObject("Excel.Application") end if Set xlWb = xlApp.Workbooks.Add If xlApp Is Nothing Then MsgBox "Impossible d'ouvrir excel" Exit Sub End If ... Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing set xlWb = Nothing

08/08/2007, 16h39
DMboup
Citation:

Envoyé par celiaaa

Voila ce que j'ai fais mais j'ai tjsr l' erreur variable objet ou variable de bloc with non définie
J'ai peut -être mal initialisé des variables..

Voila. Maintenant je crois qu'il faut déclarer la variable xlApp en global
Code:

1 2 Public xlApp As Excel.Application
08/08/2007, 17h52
celiaaa

Merci pour ton aide Mboup

Mais ça me fait la même erreur avec la variable en global..
J'ai essayé plusieurs fois avec le debuggeur en sautant le
Set xlApp = CreateObject("Excel.Application") quand le nombre de clique est supérieur à1 mais rien n'y fait :?

:cry:
10/08/2007, 16h30
thebestdave76

Je pense qu'en mettant "With xlapp. selection" au lieu de "With selection" et "XlSheet.activecell" au lieu de "Activecell, ça devrait mieux marcher.
13/08/2007, 12h20
cavo789

Bonjour

J'avoue ne pas avoir lu toute la discussion; je te suggère ceci

Remplace ton code

Code:

ActiveCell.FormulaR1C1 = "FICHE " & rs.Fields(0) & ""

par

Code:

xlSheet.ActiveCell.FormulaR1C1 = "FICHE " & rs.Fields(0) & ""

C-à-d de prefixer les lignes qui ne fonctionnent pas avec leur localisation complète afin que Access sache exactement ce qu'est ActiveCell et où le trouver.