[resolu] Copie de feuilles ...

Copie de feuilles ... [resolu] - VB/VBA/VBS - Programmation

Marsh Posté le 22-11-2005 à 15:44:19    

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 :
  1. Sub GenerateExcelFile()
  3.     ' Repertoire courant
  4.     Const CurrentDir As String = "C:\Projets\excel\"
  5.     ' Repertoire d'export des fichiers Excel a générer
  6.     Const ExcelExportDir As String = CurrentDir & "xls_built\"
  7.     ' Nom de la feuille "rappel" du contenu des fichier Excel générés
  8.     Const ContentSheet As String = "content"
  9.    
  10.     ' Compteurs de boucle
  11.     Dim l, c, i, n As Integer
  12.     ' Nom du fichier Excel en cours de traitement
  13.     Dim workFileName As String
  14.     ' Nom du modele a reprendre pour la feuille Excel a générer
  15.     Dim ModelSheetName As String
  16.     ' WorkBook de travail pour les modeles de feuille
  17.     Dim ModelWorkBook As Object
  18.     ' Classe des equipements a traiter
  19.     Dim EquipementClassCell()
  20.    
  21.     ' Initialisation des zones de classes d'equipement
  22.     EquipementClassCell = Array(8, 9)
  24.     ' Traitements non interactif
  25.     Application.ScreenUpdating = False
  26.     Application.DisplayAlerts = False
  27.    
  28.     ' Recuperation du WorkBook courant
  29.     Set ModelWorkBook = ActiveWorkBook
  30.    
  31.     ' Boucle sur tous les equipements de la feuille "Tempo"
  32.     'l = 750
  33.     'Do While l < 770
  34.     'n = 1
  35.     'Do While ModelWorkBook.Worksheets("Tempo" ).Cells(n, 1) <> ""
  36.     '    n = n + 1
  37.     'Loop
  38.     'l = 1
  39.     l = ModelWorkBook.Worksheets("Application" ).Cells(10, 5).Value
  40.     n = ModelWorkBook.Worksheets("Application" ).Cells(10, 6).Value
  41.     Do While l <= n
  43.         For x = LBound(EquipementClassCell) To UBound(EquipementClassCell)
  44.             c = EquipementClassCell(x)
  45.        
  46.             ' Recuperation du nom du modele
  47.             ModelSheetName = ModelWorkBook.Worksheets("Tempo" ).Cells(l, c)
  48.            
  49.             ' Si la classe d'equipement est defini
  50.             If ModelSheetName <> "" Then
  51.                
  52.                 ' Construction du nom du fichier Excel a générer ou a ouvrir
  53.                 workFileName = ExcelExportDir & ModelSheetName & ".xls"
  54.                 If Dir(workFileName) = "" Then
  55.                     Dim MonExcel As Object
  56.                     Set MonExcel = New Excel.Application
  57.                     MonExcel.Workbooks.Add
  58.                     i = 3
  59.                     Do While i > 1
  60.                         MonExcel.ActiveWorkBook.Worksheets(i).Delete
  61.                         i = i - 1
  62.                     Loop
  63.                    
  64.                     MonExcel.ActiveWorkBook.Worksheets(1).Name = ContentSheet
  65.                     'Range("F5:I5" ).Select
  66.                     'MonExcel.ActiveWorkBook.Worksheets(1).Selection.Font.Bold = True
  67.                     MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 1).Value = "Numéro de feuille"
  68.                     MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 2).Value = "CODE_TOTO"
  69.                     MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 3).Value = "REP_TOTO"
  70.                     MonExcel.ActiveWorkBook.Worksheets(1).Cells(1, 4).Value = "Description"
  71.                     MonExcel.ActiveWorkBook.Worksheets(1).Range("A1:E1" ).Font.Bold = True
  72.                     MonExcel.ActiveWorkBook.SaveAs workFileName
  73.                     MonExcel.ActiveWorkBook.Close
  74.                 End If
  75.                
  76.                 Set Dest = Workbooks.Open(workFileName)
  77.                
  78.                 ModelWorkBook.Worksheets(ModelSheetName).Copy After:=Dest.Worksheets(Dest.Worksheets.Count)
  79.                 Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 1).Value = Format(Dest.Worksheets.Count - 1, "000" )
  80.                 Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 2).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 1)
  81.                 Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 3).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 4)
  82.                 Dest.Worksheets(ContentSheet).Cells(Dest.Worksheets.Count, 4).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 3)
  83.                 Dest.Worksheets(ContentSheet).Columns("A:E" ).AutoFit
  84.                 'Dest.Worksheets(ContentSheet).PageSetup.PrintArea = "$A:$E"
  85.                 'Dest.Worksheets(ContentSheet).PageSetup.FitToPagesWide = 1
  86.                 'Dest.Worksheets(ContentSheet).PageSetup.FitToPagesTall = 1
  87.                 Dest.Worksheets(Dest.Worksheets.Count).Name = Format(Dest.Worksheets.Count - 1, "000" )
  88.                 Dest.Worksheets(Dest.Worksheets.Count).Cells(3, 2).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 1)
  89.                 Dest.Worksheets(Dest.Worksheets.Count).Cells(4, 2).Value = ModelWorkBook.Worksheets("Tempo" ).Cells(l, 4) & " - " & ModelWorkBook.Worksheets("Tempo" ).Cells(l, 3)
  90.                 Dest.Save
  91.                 Dest.Close
  92.             End If
  93.         Next x
  94.         l = l + 1
  95.         Call UpdateProgress(l / n)
  96.     Loop
  97.     Unload FrmProgression
  98.     MsgBox "Génération terminée"
  99.     End Sub


Message édité par senternal le 25-11-2005 à 08:51:51
Reply

Marsh Posté le 22-11-2005 à 15:44:19   

Reply

Marsh Posté le 23-11-2005 à 20:11:21    

Slaut,  
 
Pour ta 2eme question, tu peux utiliser le pas à pas détailler en appuyant sur F8. Mais si ta macro plante, le débogueur devrait normalement t' indiquer l aligne ou se situe l' erreur...
 

Message cité 1 fois
Reply

Marsh Posté le 25-11-2005 à 08:51:32    

PGreg a écrit :

Slaut,  
 
Pour ta 2eme question, tu peux utiliser le pas à pas détailler en appuyant sur F8. Mais si ta macro plante, le débogueur devrait normalement t' indiquer l aligne ou se situe l' erreur...


 
Merci pour la réponse mais je viens de modifier et simplifier la macro. Pour le debug, j'ai rapidement abandonné vu le temps que ca prenait...
 

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed