[AC-2003] Mise en page d'un fichier Excel (etat access) [Résolu]

[utan88]

Bonjour,

J'aimerai savoir comment mettre en forme un fichier excel que je crée a partir d'un état et dont je ne connait pas la destination ni le nom (c'est à l'utilisateur de le déterminer)

En effet j'arrive à créer le fichier excel correspondant à l'état mais la mise en page du fichier laisse à désirer.

J'ai trouvé plusieurs post sur le forum sur le sujet à la différence que le fichier n'est pas crée a partir d'un état.

Je vous remercie d'avance.

[Godzestla]

Bonjour,

pourquoi créer un fichier excel à partir d'un état ?
je ne comprend pas bien le but ?

Si c'est pour la mise en page, pourquoi ne pas exporter le résultat en PDF?

Mais vu que la mise en page de l'état ne te convient pas, ce n'est pas le but je suppose.

Pour reformatter ton fichier excel,

Il te faut -
- l'ouvrir
- lui appliquer un code de reformattage soit depuis Access, soit depuis un autre fichier excel (c'est la technique que j'utilise)
- sauver le résultat.

Et hop.

Maiiiiiiiiiiiiiis: sans connaître le nom et le chemin du fichier excel, comment veux-tu faire.


Voici un exemple de ma solution (c'est un SQL qui est exporté), puis le résultat est reformatté:

Appel

Code :

1
2
3
4
 Private Sub Commande100_Click()
specific_parm = ""
Export_Excelsheet "Week3 Students Count", "Week3_Students_Count", specific_parm
End Sub

procédure d'export et reformattage

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
Public Sub Export_Excelsheet(From_Table As String, to_file As String, Specific_param As Variant)
    Dim recv     As Recordset
    Dim Reci     As Recordset
    Dim Recexcel As Recordset
    Dim Argument As String
    Dim Quote    As String
    Dim nada     As Variant
 
 
    Dim Dbv  As Database
    Dim document As String
    Dim Excel_Workbook As String
 
 
    Quote = """"
    'Reference Current Database
 
    Set Dbv = DBEngine.Workspaces(0).Databases(0)
 
    'Open Recordset Zcontrol and get 1st record
 
    Set recv = Dbv.OpenRecordset("SQL_Zcontrol", , dbReadOnly)
    recv.FindFirst "DB_Year > 0"
 
    If recv.EOF Then GoTo exit_export_excelsheet
 
    'Open Recordset Installations  and get 1st record
 
    Set Reci = Dbv.OpenRecordset("SQL_Installation_Lines", , dbReadOnly)
    Reci.FindFirst "Install_Nr > 0"
 
    If Reci.NoMatch Then GoTo exit_export_excelsheet
 
    document = Trim(recv![Generated_excel_Folder]) & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls"
    Excel_Workbook = recv![Generated_File_Prefix] & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls"
    On Error Resume Next
    Kill document
 
 
    'Export
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, From_Table, document, True
 
 
    'Open Recordset Export_Excel  and get 1st record
 
    Set Recexcel = Dbv.OpenRecordset("SQL_Export_Excel", dbOpenDynaset, dbReadOnly)
    Argument = "Object_Name = '" & From_Table & "'"
    Recexcel.FindFirst Argument
 
    If Recexcel.NoMatch Then
       MsgBox to_file & " exported to " & Trim(recv![Generated_excel_Folder]) & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls"
       GoTo exit_export_excelsheet
    End If
    MsgBox to_file & " exported to " & Trim(recv![Generated_excel_Folder]) & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls (Script File '" & Trim(recv![Excel_Script_File]) & "[" & Trim(Recexcel![Script_Name]) & "]' will be applied now)"
    'Apply Formatting Excel Script
    Call Execute_Excel_Script(document, Excel_Workbook, recv![Script_Folder], recv![Excel_Script_File], Recexcel![Script_Name], Specific_param)
    Recexcel.Close
    recv.Close
    Reci.Close
 
    Set Recexcel = Nothing
    Set recv = Nothing
    Set Reci = Nothing
 
exit_export_excelsheet: '
End Sub
 
Sub Execute_Excel_Script(document As String, Excel_Workbook As String, Script_Folder As String, Excel_Script_File As String, Script_Name As String, Specific_param As Variant)
On Error Resume Next
Dim xlapp As Object
Dim ExcelWasNotRunning As Boolean    ' Indicateur de libération finale.
Dim FullScript As String
 
FullScript = Trim(Script_Folder) & Trim(Excel_Script_File)
 
Set xlapp = GetObject(, "Excel.Application")
If err <> 0 Then
   err.Clear
   ExcelWasNotRunning = True
   Set xlapp = CreateObject("Excel.application")
 Else
    ExcelWasNotRunning = False
End If
xlapp.Visible = True
Set XlWkb = xlapp.Workbooks.Open(FullScript)
 '
 ' ici nous lançons les macros automatiques d'Excel mais vous pouvez mettre du code
 '
XlWkb.RunAutoMacros xlAutoOpen
 
xlapp.Run Script_Name, document, Excel_Workbook, Excel_Script_File, Specific_param
'XlWkb.Save
XlWkb.Close
If ExcelWasNotRunning = True Then  'Reactivé 16/12/2010
    xlapp.Application.Quit
End If
 
Set XlWkb = Nothing
Set xlapp = Nothing
 
 
End Sub

Le code de reformattage se trouve dans le fichier excel ouvert par cette procédure.
Il prend en charge le traitement complet (ouverture, MEF, sauvegarde, fermeture) du fichier cible.

Un exemple simple de code de reformattage qui s'applique à cet exemple :

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
Sub Gmain_Week_Student_Count(Document As String, Excel_Workbook As String, Excel_Script_File As String, Specific_param As Variant)
 
'
' Gmain_Week_Student_Count Macro
' Macro enregistrée le 08/04/2006 par Admin
'
    Dim lrow        As Long
    Dim xlrow       As String
    Dim Range_Id    As String
    Dim Temp_Range_Id As String
    Dim off        As Long
    Dim xoff       As String
    Dim Column_from As String
    Dim Column_to   As String
 
 
    Workbooks.Open Filename:=Document
 
    Windows(Excel_Workbook).Activate
    ActiveSheet.UsedRange
    ActiveSheet.UsedRange
    Range_Id = Get_Range_Id(ActiveSheet.UsedRange.Name)
    Column_from = Trim(Get_Column_From(ActiveSheet.UsedRange.Name))
    Column_to = Trim(Get_Column_To(ActiveSheet.UsedRange.Name))
    Range(Range_Id).Select
'**********************************************
'* real VB Script Start  here                 *
'**********************************************
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveCell.SpecialCells(xlLastCell).Select
    lrow = ActiveSheet.UsedRange.Rows.Count
    xlrow = lrow
    Range_Id = Column_from & "1:" & Column_to & xlrow
    Range(Range_Id).Select
    Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(4), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Range_Id = Column_from & ":" & Column_to
    Columns(Range_Id).EntireColumn.AutoFit
    ActiveSheet.Outline.ShowLevels RowLevels:=3
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
'**********************************************
'* real VB Script Stop   here                 *
'**********************************************
    Windows(Excel_Script_File).Activate
End Sub

[utan88]

merci de vous être penché sur mon problème

mais étant donné que je dois faire un etat puis faire le fichier excel qui correspond

voici ma démarche

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
 
Private Sub btn_GenererRapportXLParAgence_Click()
        Dim XlWkb As Excel.Workbook
        Dim xlapp As Excel.Application
 
 
        '*********************Créé le rapport excel à partir de l'état "RPT_HousingParAgence_Xl"
         DoCmd.OutputTo acOutputReport, "RPT_TEST_Xl", acFormatXLS, "test.xls"
        '***************************************************************************************
 
 
        Set XlWkb = Nothing
        Set xlapp = Nothing
 
        Set xlapp = New Excel.Application
        Set XlWkb = xlapp.Workbooks.Open("c:\Documents and Settings\Moi\Mes documents\test.xls")
 
        With xlapp
        Cells.Select
        Cells.EntireColumn.AutoFit
        Cells.EntireRow.AutoFit
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End With
 
        XlWkb.Close
        xlapp.Application.Quit
 
        Set XlWkb = Nothing
        Set xlapp = Nothing
End Sub

quand je l'exécute une fois il marche nickel mais si je l'exécute droit derrière malheur sa marche plus.

Je pense que l'erreur provient du fait que le processus excel.exe est en exécution parce que je dois l’arrêter manuellement pour refaire des test.

Si quelqu'un a une idée je suis preneur.

merci

[Godzestla]

Bonjour,

ton diagnostic semble tenir la route.

je te suggère de rajouter ceci dans ton code avant le Workbooks.open pour t'en assurer définitivement.

Code :

xlapp.Visible = True

Dans mon code ci-dessous, tu verras que je teste si Excel est ouvert avant pour savoir s'il faut quitter excel après, mais j'ai vu récemment sur ce forum un sujet semblable au tien. Recherche dans les semaines précédentes. Je sais que la solution n'était pas simple mais elle fonctionnait. je regarde si je le trouve et je la rajoute dans ma réponse.

-------Edit-----------

A propos, je ne trouve pas bien normal qu'après ton formatage, tu ne sauves pas ton fichier excel avant de le fermer.

-------Edit

Voilà, j'ai touvé, ce n'était pas bien loin. Regarde ici

[utan88]

Merci de nouveau pour votre aide mais je viens de trouver l'erreur(?)

Code :

1
2
3
4
5
6
7
 
 
xlapp.Cells.Select
xlapp.Cells.EntireColumn.AutoFit
xlapp.Cells.EntireRow.AutoFit
xlapp.Selection.HorizontalAlignment = xlCenter
xlapp.Selection.VerticalAlignment = xlCenter

merci microsoft d'avoir inventé le with et faire un sort qu'il marche pas

[Godzestla]

merci microsoft d'avoir inventé le with et faire un sort qu'il marche pas

Affirmation infondée !!!


par contre, je le vois maintenant, il y a DES grosses bourdes dans ton code, à mon avis.

Code :

1
2
3
4
5
6
7
8
9
        With xlapp
        Cells.Select
        Cells.EntireColumn.AutoFit
        Cells.EntireRow.AutoFit
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End With

devrait plutot être

Code :

1
2
3
4
5
6
7
8
9
        With xlapp
        .Cells.Select
        .Cells.EntireColumn.AutoFit
        .Cells.EntireRow.AutoFit
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End With

et aussi

Code :

xlapp.cells

est quelquechose d'intriguant, car cela devrait être au moins le Workbook au lieu de l'application, et en plus vraisemblablement la feuille.

Il ne faut pas dire du mal du concepteur d'un logiciel si on ne comprend pas son utilisation.

[utan88]

le code que vous avez posté était le code que j'avais avant et qui posait donc problème et le code que j'ai posté c'est le code qui fait que sa marche.

pour ce qui est du workbook ou l'application sachez que j'ai testé avec les deux et le résultat était le même.

Je vous remercie de votre aide