Discussion :

[yannr29]

Bonjour à tous,

J'ai parcouru plusieurs discussions pour trouver la réponse à ma question mais après plusieurs tentatives infructueuses, je m'en remets à vous.

Je suis vraiment débutant dans les macros et j'aimerais pouvoir appliquer une macro à tout un dossier contenant plus de 400 fichiers Excel.

La macro est question est simple, j'ajuste toutes les largeurs de colonne au contenu et fait en sorte que mon tableau s'imprime sur une page A3.

Après reste a l'appliquer à mes 400 fichiers sans avoir à tous les ouvrir un par un...

Est-ce que vous pouvez m'aider ???

Le code généré par visual basic est le suivant :

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
Sub yann()
'
' yann Macro
'
 
'
    Cells.Select
    Cells.EntireColumn.AutoFit
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    ActiveWindow.SelectedSheets.PrintPreview
    Range("E9").Select
    ActiveWindow.View = xlPageBreakPreview
    ActiveWorkbook.Save
End Sub

Merci d'avance à tous.
Yann

[marot_r]

Bonjour.

Cette demande ne devrait-elle pas être dans le forum Excel. Qu'elle est l'intérêt de Access ici ?
L'avantage de le faire en Excel c'est que tu n'as pas a instancier Excel avec Access ce qui simplifie la programmation.

Autant que je sache, il n'y a pas d'autre méthode que d'ouvrir chacun des fichiers puis de lui appliquer la marco.

Voici un exemple de code qui fait cela

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
private sub FormaterExcel()
   const CHEMIN_FICHIER as string = "X:\TonChemin\"
   const TEMPLATE_FICHIER as string="*.xls*" 
 
   Dim xlApp As object :Set xlApp = CreateObject("Excel.Application") 'Excel.Application
   xlApp.visible=true 'Rendre Excel visible semble faciliter sa fermeture et sa désintanctiation après.
   Dim xlBook As object 'Excel.Workbook
   Dim xlSheet As object 'Excel.WorkSheet
 
   dim nomFic as string:nomFic=dir(CHEMIN_FICHIER & TEMPLATE_FICHIER)
 
   do while nomFic<>""
       set  xlBook=xlApp.Workbooks.open(CHEMIN_FICHIER & momFic) 
       set xlSheet=xlBook.Worksheets(1)
       xlBook.activate
       xlSheet.activate
       xlSheet.Cells.Select
       xlSheet.Cells.EntireColumn.AutoFit
 
       With xlSheet.PageSetup
          .PrintTitleRows = ""
          .PrintTitleColumns = ""
      End With
 
      xlSheet.PageSetup.PrintArea = ""
 
      xlSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
      End With
 
      ActiveWindow.SelectedSheets.PrintPreview 'il faudra peut-être adapter cela
      Range("E9").Select
      ActiveWindow.View = xlPageBreakPreview 'il faudra peut-être adapter cela
      xlBook.Save
      xlBook.close
      set xlSheet=nothing
      set xlBook=nothing
 
      nomFic=dir() 'trouve le prochain fichier
 
   loop
 
   xlApp.quit:set xlApp=nothing 'ou xlApp.close je ne me souviens plus.
 
end sub

[yannr29]

Bonjour Marot_r,

Désolé pour l'erreur, les dernières discussions qui parlaient de ce type de demande étaient dans cette partie du forum alors j'ai fait pareil :s

Je teste tout de suite votre solution.

Merci en tout cas pour votre aide.
Yann

Désolé mais cela ne fonctionne pas

J'ai une multitude d'erreurs, surtout dans la partie de paramétrage de la mise en page. J'ai tenté de tout supprimer et ne laisser que "l'autofit" des cellules et là il ne trouve plus mon dossier de référence :s

D'après ce que j'ai pu lire, il faut bien finir le chemin par un "\" mais quand je le fait Excel s'ouvre et se ferme... Donc, je pense qu'il faut bien le laisser.

Voici ce que j'ai (j'ai tout mis sur le bureau pour tester et le dossier n'est pas en lecture seule):
Const CHEMIN_FICHIER As String = "C:\Users\yann.r\Desktop\test\"

La macro bloque en fait ici :

Code :

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

1
2
 Do While nomFic <> ""
       Set xlBook = xlApp.Workbooks.Open(CHEMIN_FICHIER & momFic)

Un conseil ?

Yann

[marot_r]

Bonjour.

J'ai fait une faute de frappe. Il faut tapper nomFic et non momFic.

Si ce n'est pas cela le problème, as-tu un message d'erreur ou quelque chose ?

Pour le \, il faut que le chemin soit valide et ressemble à X:\TonChemin\TonFichier.xls et le dir() retourne simplement TonFichier.xls donc il est indispensable.

Pour faire du débugage tu peux neutraliser tout le code de formatage et te concentrer sur la boucle.
Une fois qu'elle ouvre bien et ferme tous les fichiers tu peux réactiver le code de formatage.

A+