génération d'un xls dans une macro

Version imprimable

Bonjour tout le monde !

J'essaie de générer un fichier resultat.xls à partir d'une macro située dans genere.xls.

Alors voilà le code que j'ai trouvé :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Private Sub Command1_Click() Dim xlApp As New Excel.Application Dim xlBook As Workbook Dim NomFichier As String Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add '.... ici on rajoute du code... NomFichier = "D:\DONNEES\Commun\Calculateur\resultat.xls" xlBook.SaveAs NomFichier xlBook.Close xlApp.Quit Set xlBook = Nothing Set xlApp = Nothing End Sub
Lorsqu'on est dans le Visual Basic Editor, et qu'on execute la macro, resultat.xls se génère bien, par contre quand on ferme tout et qu'on lance genere.xls, on obtiens rien.

Le but étant qu'une execution de genere.xls créé résultat.xls (sans l'ouvrir)

A votre avis, que manque-t-il dans ma macro ??

16/12/2010, 13h48
pgz

Bonjour.

Je n'ai pas compris ton problème.
En plus le sens de

Citation:

Le but étant qu'une execution de genere.xls créé résultat.xls (sans l'ouvrir)

m'échappe totalement.

Deux remarques quand même :
tu crées une nouvelle application Excel. Cela n'est pas utile, tu peux utiliser l'application du classeur "génère.xls". Cela peut même être très gênant si tu dois faire des copies de "génère" vers "resultats".
Si ton classeur "résultats" a toujurs le même chemin et le même nom, tu ne pourras le créer qu'une fois.

Cordialement,

PGZ
16/12/2010, 14h05
ajor

Bonjour,

Merci pour ta réponse.

Voici quelques précisions car mon histoire n'est pas claire :

j'ai déjà créé la macro (elle est assez lourde, appelle une base oracle, etc) qui met à jour le fichier résultat.xls, mais cette macro est située dans le fichier résultat.xls.
Donc dès qu'on veut ouvrir resultat.xls, on est obligé de déclencher cette macro. Or j'aimerais que la macro soit situé dans un autre fichier appelé genere.xsl, afin qu'on puisse utiliser resultat.xls, sans regénérer le fichier à chaque fois qu'on l'ouvre.

Est-ce que tu vois mieux ce que je veux dire ?
16/12/2010, 16h17
pgz

Re,

Citation:

Envoyé par ajor

Voici quelques précisions car mon histoire n'est pas claire :

Bon début...

Citation:

Envoyé par ajor

j'ai déjà créé la macro (elle est assez lourde, appelle une base oracle, etc) qui met à jour le fichier résultat.xls, mais cette macro est située dans le fichier résultat.xls.
Donc dès qu'on veut ouvrir resultat.xls, on est obligé de déclencher cette macro.

Je ne vois pas pourquoi. Ce n'est pas parce qu'un classeur contient une macro qu'on est obligé de l'exécuter dès qu'on ouvre ce classeur.

Citation:

Envoyé par ajor

Est-ce que tu vois mieux ce que je veux dire ?

Du coup, je ne vois pas le problème.

Si tu tiens à diffuser le classeur Resultat sans la macro de mise à jour, tu peux toujours mettre dans Resultat une autre macro qui crée un claseur en copiant les feuilles et pas le code.

Cordialement,

PGZ
17/12/2010, 10h29
ajor

Le truc c'est que mon fichier resultat.xls sera régénéré automatiquement une fois par jour sur un serveur puis copié sur des postes clients, qui eux devront pouvoir l'ouvrir sans problème.

Dans ce cas, comment dois-je faire à ton avis ?

bonjour,

si j'ai bien compris

tu dois mettre ton code dans l'événement OPEN du workbook genere.xls

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Workbook_Open()
Dim xlApp As New Excel.Application
Dim xlBook As Workbook
Dim NomFichier As String
 
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
 
'.... ici on rajoute du code...
 
NomFichier = "D:\DONNEES\Commun\Calculateur\resultat.xls"
xlBook.SaveAs NomFichier 
xlBook.Close
xlApp.Quit
 
Set xlBook = Nothing 
Set xlApp = Nothing
End Sub

Salut mayekeul,

ça ne fonctionne toujours pas, mais je ne sais pas si je m'y prend bien.

Voici le code de mon fichier genere.xls

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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Option Explicit
 
Public cN As ADODB.Connection
Public rs As ADODB.Recordset
 
Public Function conNect() As Boolean
 
    On Error GoTo conNect_Err
    Set cN = New ADODB.Connection
    cN.ConnectionString = "Provider=****;Data Source=*****;User Id=****;Password=*****;"
    cN.Open
    conNect = True
    Exit Function
 
conNect_Err:
 
    MsgBox Err.Number & vbCr & Err.Description
    conNect = True
 
End Function
 
Public Function DeconNect() As Boolean
 
    On Error Resume Next
    cN.Close
    Set cN = Nothing
 
End Function
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWorkbook.Saved = False
 
End Sub
 
 
 
 
 
 
Private Sub Workbook_Open()
Dim xlApp As New Excel.Application
Dim xlBook As Workbook
Dim NomFichier As String
Dim strSQL As String
Dim i As Integer
Dim j As Integer
 
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
 
    On Error GoTo Workbook_Open_Err
    Feuil1.Cells(1, 1) = "id_indice"
    Feuil1.Cells(1, 2) = "cote"
    If conNect() = True Then
 
 
 
        Set rs = New ADODB.Recordset
        rs.CursorLocation = adUseClient
 
strSQL = ""
strSQL = strSQL & "select cote.indice ind99, "
strSQL = strSQL & "       cote.cote_actuelle cot99 "
strSQL = strSQL & "  from t_detail_vin pr, "
strSQL = strSQL & "       type_vin vin, "
strSQL = strSQL & "      (select ind.id_tvin, "
strSQL = strSQL & "              ind.milesime millesime, "
strSQL = strSQL & "              c.cote cote_actuelle, "
strSQL = strSQL & "              ind.id_indice indice "
strSQL = strSQL & "         from t_indices ind, "
strSQL = strSQL & "              cote_annuelle c "
strSQL = strSQL & "        where ind.id_indice = c.id_indice"
strSQL = strSQL & "          and ind.format in('Bouteille') "
strSQL = strSQL & "          and c.annee='2010' "
strSQL = strSQL & "          and ind.id_indice not in ('1','2','3') "
'strSQL = strSQL & "          and ind.id_indice < '50') cote "
strSQL = strSQL & "          ) cote "
strSQL = strSQL & "  where vin.id_tvin = pr.id_tvin "
strSQL = strSQL & "    and pr.milesime = cote.millesime "
strSQL = strSQL & "    and vin.id_tvin=cote.id_tvin "
strSQL = strSQL & "    and vin.proprietaire not in ('Indifferent') "
strSQL = strSQL & "    and vin.proprietaire is not null "
strSQL = strSQL & "  order by cote.indice"
 
      rs.Open strSQL, cN, adOpenForwardOnly, adLockOptimistic
 
        If rs.RecordCount > 0 Then
 
            j = 1
            i = 1
 
          Do While Not rs.EOF And Not rs.BOF
 
    i = i + 1
    Feuil1.Cells(i, j) = rs("ind99")
    Feuil1.Cells(i, j + 1) = rs("cot99")
    rs.MoveNext
 
Loop
 
        End If
 
        DeconNect
        ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWorkbook.Saved = False
    Else
 
        'blablabla
 
    End If
 
    Exit Sub
 
Workbook_Open_Err:
MsgBox Err.Number & vbCr & Err.Description
 
Workbook_BeforeClose (True)
 
NomFichier = "D:\DONNEES\Commun\Calculateur\resultat.xls"
xlBook.SaveAs NomFichier
xlBook.Close
xlApp.Quit
 
Set xlBook = Nothing
Set xlApp = Nothing
 
End Sub

A priori pas de soucis au niveau connexion, ni au niveau requête, puisque ça fonctionnait bien.
Par contre je n'ai pas de fichier résultat.xls généré dans le répertoire indiqué...

17/12/2010, 12h38
mayekeul

bonjour,

c'est normal que tu veuille l'enregistrer si le code génere une erreur?

en cas de non erreur, le code n'enregistre pas "resultat.xls"

question(bete mais on sais jamais) : le code Workbook_Open est bien dans l'object ThisWorkbook?
17/12/2010, 12h44
ajor

Oui le code est dans ThisWOrkbook

Par contre, non, je voudrais qu'il soit enregistré s'il n'y a pas d'erreur.
S'il y a une erreur, je voudrais qu'il y ait un petit message d'erreur, et pas d'enregistrement.
17/12/2010, 12h46
mayekeul

ton code fait juste le contraire

déplace la levée d'exception en fin de code
(avec le exit sub surtout ;))

D'accord ! le fichier resultat.xls est maintenant généré. Par contre, il n'y a rien dedans... Le contenu est resté dans genre.xls

Que manque-t-il pour "déplacer le contenu" ?

Voici mon code actuellement :

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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Option Explicit
 
Public cN As ADODB.Connection
Public rs As ADODB.Recordset
 
Public Function conNect() As Boolean
 
    On Error GoTo conNect_Err
    Set cN = New ADODB.Connection
    cN.ConnectionString = "Provider=***;Data Source=***User Id=***;Password=***"
    cN.Open
    conNect = True
    Exit Function
 
conNect_Err:
 
    MsgBox Err.Number & vbCr & Err.Description
    conNect = True
 
End Function
 
Public Function DeconNect() As Boolean
 
    On Error Resume Next
    cN.Close
    Set cN = Nothing
 
End Function
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWorkbook.Saved = False
End Sub
 
Private Sub Workbook_Open()
Dim xlApp As New Excel.Application
Dim xlBook As Workbook
Dim NomFichier As String
Dim strSQL As String
Dim i As Integer
Dim j As Integer
 
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
 
    On Error GoTo Workbook_Open_Err
    Feuil1.Cells(1, 1) = "id_indice"
    Feuil1.Cells(1, 2) = "cote"
    If conNect() = True Then
 
 
 
        Set rs = New ADODB.Recordset
        rs.CursorLocation = adUseClient
 
strSQL = ""
strSQL = strSQL & "select cote.indice ind99, "
strSQL = strSQL & "       cote.cote_actuelle cot99 "
strSQL = strSQL & "  from t_detail_vin pr, "
strSQL = strSQL & "       type_vin vin, "
strSQL = strSQL & "      (select ind.id_tvin, "
strSQL = strSQL & "              ind.milesime millesime, "
strSQL = strSQL & "              c.cote cote_actuelle, "
strSQL = strSQL & "              ind.id_indice indice "
strSQL = strSQL & "         from t_indices ind, "
strSQL = strSQL & "              cote_annuelle c "
strSQL = strSQL & "        where ind.id_indice = c.id_indice"
strSQL = strSQL & "          and ind.format in('Bouteille') "
strSQL = strSQL & "          and c.annee='2010' "
strSQL = strSQL & "          and ind.id_indice not in ('1','2','3') "
'strSQL = strSQL & "          and ind.id_indice < '50') cote "
strSQL = strSQL & "          ) cote "
strSQL = strSQL & "  where vin.id_tvin = pr.id_tvin "
strSQL = strSQL & "    and pr.milesime = cote.millesime "
strSQL = strSQL & "    and vin.id_tvin=cote.id_tvin "
strSQL = strSQL & "    and vin.proprietaire not in ('Indifferent') "
strSQL = strSQL & "    and vin.proprietaire is not null "
strSQL = strSQL & "  order by cote.indice"
 
      rs.Open strSQL, cN, adOpenForwardOnly, adLockOptimistic
 
        If rs.RecordCount > 0 Then
 
            j = 1
            i = 1
 
          Do While Not rs.EOF And Not rs.BOF
 
    i = i + 1
    Feuil1.Cells(i, j) = rs("ind99")
    Feuil1.Cells(i, j + 1) = rs("cot99")
    rs.MoveNext
 
Loop
 
        End If
 
        DeconNect
        ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWorkbook.Saved = False
 
Workbook_Open_Err:
MsgBox Err.Number & vbCr & Err.Description
 
Workbook_BeforeClose (True)
 
NomFichier = "D:\DONNEES\Commun\Calculateur\resultat.xls"
xlBook.SaveAs NomFichier
xlBook.Close
xlApp.Quit
 
    Else
 
        'blablabla
 
 
    End If
 
    Exit Sub
 
 
 
Set xlBook = Nothing
Set xlApp = Nothing
 
End Sub

17/12/2010, 13h06
mayekeul

ce que je vois
c'est que tu crée un fichier "resultat" mais les changement que je vois que le code effectue est sur le classeur courant donc "genere.xls"

mais je ne vois pas tout le code
20/12/2010, 11h49
ajor

Si, j'ai mis tout le code ci-dessus.

Qu'est-ce que je dois changer pour que le contenu soit sur resultat.xls et non sur genere.xls ?

bonjour,

en faisant de la sorte

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
Private Sub Workbook_Open()
Dim xlApp As New Excel.Application
Dim xlBook As Workbook
Dim NomFichier As String
Dim strSQL As String
Dim i As Integer
Dim j As Integer
 
If Not Dir("D:\DONNEES\Commun\Calculateur\resultat.xls") = "" Then
    Set xlBook = GetObject("D:\DONNEES\Commun\Calculateur\resultat.xls")
Else
    Set xlBook = Workbooks.Add
End If
 
xlBook.Sheets(1).Cells(1, 1) = "id_indice"
xlBook.Sheets(1).Cells(1, 2) = "cote"
 
If Connect() = True Then
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    strSQL = ""
    strSQL = strSQL & "select cote.indice ind99, "
    strSQL = strSQL & "       cote.cote_actuelle cot99 "
    strSQL = strSQL & "  from t_detail_vin pr, "
    strSQL = strSQL & "       type_vin vin, "
    strSQL = strSQL & "      (select ind.id_tvin, "
    strSQL = strSQL & "              ind.milesime millesime, "
    strSQL = strSQL & "              c.cote cote_actuelle, "
    strSQL = strSQL & "              ind.id_indice indice "
    strSQL = strSQL & "         from t_indices ind, "
    strSQL = strSQL & "              cote_annuelle c "
    strSQL = strSQL & "        where ind.id_indice = c.id_indice"
    strSQL = strSQL & "          and ind.format in('Bouteille') "
    strSQL = strSQL & "          and c.annee='2010' "
    strSQL = strSQL & "          and ind.id_indice not in ('1','2','3') "
    'strSQL = strSQL & "          and ind.id_indice < '50') cote "
    strSQL = strSQL & "          ) cote "
    strSQL = strSQL & "  where vin.id_tvin = pr.id_tvin "
    strSQL = strSQL & "    and pr.milesime = cote.millesime "
    strSQL = strSQL & "    and vin.id_tvin=cote.id_tvin "
    strSQL = strSQL & "    and vin.proprietaire not in ('Indifferent') "
    strSQL = strSQL & "    and vin.proprietaire is not null "
    strSQL = strSQL & "  order by cote.indice"
 
    rs.Open strSQL, cN, adOpenForwardOnly, adLockOptimistic
 
    If rs.RecordCount > 0 Then
        j = 1
        i = 1
        Do While Not rs.EOF And Not rs.BOF
            i = i + 1
            xlBook.Sheets(1).Cells(i, j) = rs("ind99")
            xlBook.Sheets(1).Cells(i, j + 1) = rs("cot99")
            rs.MoveNext
        Loop
    End If
    DeconNect
    xlBook.Save
    Application.DisplayAlerts = False
    ActiveWorkbook.Saved = False
Else
    'bla bla
End If
 
 
End Sub

20/12/2010, 12h49
ajor

Merci !

Quand j'exécute cette requête, un fichier résultat est créé. Son poid augmente normalement, donc ça a l'air de fonctionner.
Par contre quand j'essaie d'ouvrir résultat, il n'y a rien qui s'ouvre, aucune feuille.

Ne faut-il pas créer une feuille dans le code ?

essaye comme cela

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
Private Sub Workbook_Open()
Dim xlApp As New Excel.Application
Dim xlBook As Workbook
Dim NomFichier As String
Dim strSQL As String
Dim i As Integer
Dim j As Integer
 
If Not Dir("D:\DONNEES\Commun\Calculateur\resultat.xls") = "" Then
    Set xlBook = GetObject("D:\DONNEES\Commun\Calculateur\resultat.xls")
Else
    Set xlBook = Workbooks.Add
End If
 
xlBook.Sheets(1).Cells(1, 1) = "id_indice"
xlBook.Sheets(1).Cells(1, 2) = "cote"
 
If Connect() = True Then
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    strSQL = ""
    strSQL = strSQL & "select cote.indice ind99, "
    strSQL = strSQL & "       cote.cote_actuelle cot99 "
    strSQL = strSQL & "  from t_detail_vin pr, "
    strSQL = strSQL & "       type_vin vin, "
    strSQL = strSQL & "      (select ind.id_tvin, "
    strSQL = strSQL & "              ind.milesime millesime, "
    strSQL = strSQL & "              c.cote cote_actuelle, "
    strSQL = strSQL & "              ind.id_indice indice "
    strSQL = strSQL & "         from t_indices ind, "
    strSQL = strSQL & "              cote_annuelle c "
    strSQL = strSQL & "        where ind.id_indice = c.id_indice"
    strSQL = strSQL & "          and ind.format in('Bouteille') "
    strSQL = strSQL & "          and c.annee='2010' "
    strSQL = strSQL & "          and ind.id_indice not in ('1','2','3') "
    'strSQL = strSQL & "          and ind.id_indice < '50') cote "
    strSQL = strSQL & "          ) cote "
    strSQL = strSQL & "  where vin.id_tvin = pr.id_tvin "
    strSQL = strSQL & "    and pr.milesime = cote.millesime "
    strSQL = strSQL & "    and vin.id_tvin=cote.id_tvin "
    strSQL = strSQL & "    and vin.proprietaire not in ('Indifferent') "
    strSQL = strSQL & "    and vin.proprietaire is not null "
    strSQL = strSQL & "  order by cote.indice"
 
    rs.Open strSQL, cN, adOpenForwardOnly, adLockOptimistic
 
    If rs.RecordCount > 0 Then
        j = 1
        i = 1
        Do While Not rs.EOF And Not rs.BOF
            i = i + 1
            xlBook.Sheets(1).Cells(i, j) = rs("ind99")
            xlBook.Sheets(1).Cells(i, j + 1) = rs("cot99")
            rs.MoveNext
        Loop
    End If
    DeconNect
    xlbook.windows(1).visible=true
    xlBook.Save
    Application.DisplayAlerts = False
    ActiveWorkbook.Saved = False
Else
    'bla bla
End If
 
 
End Sub

20/12/2010, 13h14
ajor

Merci beaucoup !

ça marche très bien...

j'ai encore quelques modifs à faire (renommage de feuilles, fermeture automatique, etc) mais je pense que je vais y arriver seul

Merci d'avoir passer du temps sur ma demande

Bonne journée !