senternal | Bonjour,
J'ai un double soucis...
J'ai une macro Excel "magique" qui copie des feuilles d'un fichier vers d'autres fichiers (environ 700/800 copies). Cette macro fonctionne pas trop mal mais semble planter lamentablement apres 80/90 copies...
Ma première question est : comment faire pour eviter que Excel affiche a chaque ouverture du fichier destination le-dit fichier Excel faisant apparaitre puis disparaitre un element dans la barre des taches de Windows
Ma seconde question est : comment savoir simplement ou a planter la macro (je cherche pour l'instant une solution simple)
Le code : (les corrections peuvent etre utiles si des gourous du vb/vba passent...)
Code :
- Sub GenerateExcelFile()
- ' Repertoire courant
- Const CurrentDir As String = "C:\Projets\excel\"
- ' Repertoire d'export des fichiers Excel a générer
- Const ExcelExportDir As String = CurrentDir & "xls_built\"
- ' Nom de la feuille "rappel" du contenu des fichier Excel générés
- Const ContentSheet As String = "content"
-
- ' Compteurs de boucle
- Dim l, c, i, n As Integer
- ' Nom du fichier Excel en cours de traitement
- Dim workFileName As String
- ' Nom du modele a reprendre pour la feuille Excel a générer
- Dim ModelSheetName As String
- ' WorkBook de travail pour les modeles de feuille
- Dim ModelWorkBook As Object
- ' Classe des equipements a traiter
- Dim EquipementClassCell()
-
- ' Initialisation des zones de classes d'equipement
- EquipementClassCell = Array(8, 9)
- ' Traitements non interactif
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
-
- ' Recuperation du WorkBook courant
- Set ModelWorkBook = ActiveWorkBook
-
- ' Boucle sur tous les equipements de la feuille "Tempo"
- 'l = 750
- 'Do While l < 770
- 'n = 1
- 'Do While ModelWorkBook.Worksheets("Tempo" ).Cells(n, 1) <> ""
- ' n = n + 1
- 'Loop
- 'l = 1
- l = ModelWorkBook.Worksheets("Application" ).Cells(10, 5).Value
- n = ModelWorkBook.Worksheets("Application" ).Cells(10, 6).Value
- Do While l <= n
- For x = LBound(EquipementClassCell) To UBound(EquipementClassCell)
- c = EquipementClassCell(x)
-
- ' Recuperation du nom du modele
- ModelSheetName = ModelWorkBook.Worksheets("Tempo" ).Cells(l, c)
-
- ' Si la classe d'equipement est defini
- If ModelSheetName <> "" Then
-
- ' Construction du nom du fichier Excel a générer ou a ouvrir
- workFileName = ExcelExportDir & ModelSheetName & ".xls"
- If Dir(workFileName) = "" Then
- Dim MonExcel As Object
- Set MonExcel = New Excel.Application
- MonExcel.Workbooks.Add
- i = 3
- Do While i > 1
- MonExcel.ActiveWorkBook.Worksheets(i).Delete
- i = i - 1
- Loop
-
- MonExcel.ActiveWorkBook.Worksheets(1).Name = ContentSheet
- 'Range("F5:I5" ).Select
- 'MonExcel.ActiveWorkBook.Worksheets(1).Selection.Font.Bold = True
- MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 1).Value = "Numéro de feuille"
- MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 2).Value = "CODE_TOTO"
- MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 3).Value = "REP_TOTO"
- MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 4).Value = "Description"
- MonExcel.ActiveWorkBook.Worksheets(1).Range("A1:E1" ).Font.Bold = True
- MonExcel.ActiveWorkBook.SaveAs workFileName
- MonExcel.ActiveWorkBook.Close
- End If
-
- Set Dest = Workbooks.Open(workFileName)
-
- ModelWorkBook.Worksheets(ModelSheetName).Copy After:=Dest.Worksheets(Dest.Worksheets.Count)
- Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 1).Value = Format(Dest.Worksheets.Count - 1, "000" )
- Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 2).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 1)
- Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 3).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 4)
- Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 4).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 3)
- Dest.Worksheets(ContentSheet).Columns("A:E" ).AutoFit
- 'Dest.Worksheets(ContentSheet).PageSetup.PrintArea = "$A:$E"
- 'Dest.Worksheets(ContentSheet).PageSetup.FitToPagesWide = 1
- 'Dest.Worksheets(ContentSheet).PageSetup.FitToPagesTall = 1
- Dest.Worksheets(Dest.Worksheets.Count).Name = Format(Dest.Worksheets.Count - 1, "000" )
- Dest.Worksheets(Dest.Worksheets.Count).Cells(3, 2).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 1)
- Dest.Worksheets(Dest.Worksheets.Count).Cells(4, 2).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 4) & " - " & ModelWorkBook.Worksheets("Tempo" ).Cells(l, 3)
- Dest.Save
- Dest.Close
- End If
- Next x
- l = l + 1
- Call UpdateProgress(l / n)
- Loop
- Unload FrmProgression
- MsgBox "Génération terminée"
- End Sub
|
Message édité par senternal le 25-11-2005 à 08:51:51
|