Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1623 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA] Travail sur fichier excel en arrière plan

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[VBA] Travail sur fichier excel en arrière plan

n°2283477
Takama13
Posté le 10-06-2016 à 15:13:04  profilanswer
 

Bonjour,

 

Voici le contexte :
J'ai un fichier excel de travail contenant des informations et des formules.
Afin de partager l'information de ce fichier avec d'autres personnes, j'ai créé une macro qui recopie les informations de ce fichier source en supprimant toutes les formules et en supprimant certaines lignes inutiles.
J'ai donc 3 fichiers :
- fichier excel source
- fichier excel avec la macro (un userform est utilisé)
- fichier excel de destination, créé par la macro

 

La macro fonctionne très bien sauf que depuis peu, nous sommes passés à mon travail d'Office 2003 à Office 2013. Et depuis, chaque fois que la macro ouvre mon fichier source, celui se met au 1er plan et masque mon userform.
La macro fonctionne très bien, mon 'problème' est juste d'ordre esthétique.
Pour le résoudre, je me suis dit que j'allais travailler sur mon fichier source en arrière plan. J'ai donc modifié mon code comme ci-dessous.

 

(je n'ai gardé que les lignes "intéressantes" pour vous, il y a d'autres tâches effectuées en parallèles)

 

Macro qui marche mais qui masque mon userform :

 
Code :
  1. Private Sub Ancienne_Macro()
  2.  
  3. [...]
  4.      Application.ScreenUpdating = False   
  5.    
  6.      Application.Workbooks.Open Filename:=DataServ(i + 1, 2), ReadOnly:=True
  7.      'Copie dans un nouveau fichier
  8.      Workbooks(Dir(DataServ(i + 1, 2))).Sheets(1).Range("A1:" & DerCol & nLigFin).Copy
  9.      Workbooks.Add
  10.      Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  11.      Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  12.    
  13.     'Suppression des lignes inutiles
  14.     'Le tableau "LinesToDelete" va chercher la liste des lignes que je veux supprimer dans mon tableau "DataServ"
  15.      LinesToDelete = Split(DataServ(i + 1, 7), "," )
  16.      Application.CutCopyMode = False
  17.      Set RangeToDelete = ActiveSheet.Rows(LinesToDelete(1)) 'je sélectionne la 1ère ligne à supprimer
  18.    
  19.      'le code ci-dessous permet de sélectionner les autres lignes et de les ajouter les unes aux autres
  20.      For j = 1 To nLigFin Step NbLine
  21.       For k = 0 To UBound(LinesToDelete)
  22.          Set RangeToDelete = Union(RangeToDelete, ActiveSheet.Rows(LinesToDelete(k) + j - 1))
  23.       Next k
  24.      Next j
  25.      'une fois toutes les lignes sélectionnées, je les supprime
  26.      RangeToDelete.Delete Shift:=xlUp
  27.                  
  28.     'Ajustement graphique
  29.      With ActiveWorkbook
  30.         .Title = ""
  31.         .Subject = ""
  32.         .Author = ""
  33.         .Keywords = ""
  34.         .Comments = ""
  35.      End With
  36.    
  37.      With Application
  38.         .Calculation = xlAutomatic
  39.         .MaxChange = 0.001
  40.      End With
  41.    
  42.      ActiveWorkbook.PrecisionAsDisplayed = False
  43.    
  44.      With ActiveSheet.PageSetup
  45.          .PrintTitleRows = ""
  46.          .PrintTitleColumns = ""
  47.      End With
  48.    
  49.     [...]
  50.          
  51.      Application.PrintCommunication = False
  52.      With ActiveSheet.PageSetup
  53.          .PrintArea = "$A$1:" & DerCol & nLigFin
  54.          .LeftMargin = Application.InchesToPoints(0.177165354330709)
  55.          .RightMargin = Application.InchesToPoints(0.177165354330709)
  56.          .TopMargin = Application.InchesToPoints(0.708661417322835)
  57.          .BottomMargin = Application.InchesToPoints(0.354330708661417)
  58.          .HeaderMargin = Application.InchesToPoints(0)
  59.          .FooterMargin = Application.InchesToPoints(0.196850393700787)
  60.          .PrintHeadings = False
  61.          .PrintGridlines = False
  62.          .PrintComments = xlPrintNoComments
  63.          .CenterHorizontally = True
  64.          .CenterVertically = True
  65.          .Orientation = PrintOrientation
  66.          .Draft = False
  67.          .PaperSize = xlPaperA4
  68.          .FirstPageNumber = xlAutomatic
  69.          .Order = xlDownThenOver
  70.          .BlackAndWhite = False
  71.          .Zoom = False
  72.          .FitToPagesWide = 1
  73.          .FitToPagesTall = 1
  74.      End With
  75.      Application.PrintCommunication = True
  76.    
  77.      Application.ScreenUpdating = True
  78.          
  79.      [...]
  80. End Sub
 


Pour travailler en arrière plan, je travaille sur une nouvelle instance d'Excel.
Ma nouvelle macro :

 
Code :
  1. Option Base 1
  2. Dim xlApp As New Excel.Application
  3. Dim xlBook, xlBook2 As New Excel.Workbook
  4. Dim xlSheet As New Excel.Worksheet
  5. Private Sub Nouvelle_Macro()
  6.  
  7. [...]
  8.      Application.ScreenUpdating = False
  9.      
  10.      Set xlBook = xlApp.Workbooks.Open(Filename:=DataServ(i + 1, 2), ReadOnly:=True)
  11.      'Copie dans un nouveau fichier
  12.      Set xlBook2 = xlApp.Workbooks.Add
  13.      xlBook.Sheets(1).Range("A1:" & DerCol & nLigFin).Copy
  14.      With xlBook2.Sheets(1).Range("A1" )
  15.       .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  16.       .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  17.      End With
  18.    
  19.      'Suppression des lignes inutiles
  20.      'Le tableau "LinesToDelete" va chercher la liste des lignes que je veux supprimer dans mon tableau "DataServ"
  21.      LinesToDelete = Split(DataServ(i + 1, 7), "," ) 'Chargement des lignes à supprimer
  22.      xlApp.CutCopyMode = False
  23.      Set RangeToDelete = xlBook2.Sheets(1).Rows(LinesToDelete(1)) 'je sélectionne la 1ère ligne à supprimer
  24.    
  25.      'le code ci-dessous permet de sélectionner les autres lignes et de les ajouter les unes aux autres
  26.      For j = 1 To nLigFin Step NbLine
  27.       For k = 0 To UBound(LinesToDelete)
  28.          Set RangeToDelete = Union(RangeToDelete, xlBook2.Sheets(1).Rows(LinesToDelete(k) + j - 1))
  29.       Next k
  30.      Next j
  31.      'une fois toutes les lignes sélectionnées, je les supprime
  32.      RangeToDelete.Delete Shift:=xlUp
  33.                  
  34.     'Ajustement graphique
  35.      With xlBook2
  36.         .Title = ""
  37.         .Subject = ""
  38.         .Author = ""
  39.         .Keywords = ""
  40.         .Comments = ""
  41.      End With
  42.    
  43.      With xlApp
  44.         .Calculation = xlAutomatic
  45.         .MaxChange = 0.001
  46.      End With
  47.    
  48.      xlBook2.PrecisionAsDisplayed = False
  49.    
  50.      With xlBook2.Sheets(1).PageSetup
  51.          .PrintTitleRows = ""
  52.          .PrintTitleColumns = ""
  53.      End With
  54.    
  55.      xlApp.PrintCommunication = False
  56.      With xlBook2.Sheets(1).PageSetup
  57.          .PrintArea = "$A$1:" & DerCol & nLigFin
  58.          .LeftMargin = Application.InchesToPoints(0.177165354330709)
  59.          .RightMargin = Application.InchesToPoints(0.177165354330709)
  60.          .TopMargin = Application.InchesToPoints(0.708661417322835)
  61.          .BottomMargin = Application.InchesToPoints(0.354330708661417)
  62.          .HeaderMargin = Application.InchesToPoints(0)
  63.          .FooterMargin = Application.InchesToPoints(0.196850393700787)
  64.          .PrintHeadings = False
  65.          .PrintGridlines = False
  66.          .PrintComments = xlPrintNoComments
  67.          .CenterHorizontally = True
  68.          .CenterVertically = True
  69.          .Orientation = PrintOrientation
  70.          .Draft = False
  71.          .PaperSize = xlPaperA4
  72.          .FirstPageNumber = xlAutomatic
  73.          .Order = xlDownThenOver
  74.          .BlackAndWhite = False
  75.          .Zoom = False
  76.          .FitToPagesWide = 1
  77.          .FitToPagesTall = 1
  78.      End With
  79.      xlApp.PrintCommunication = True
  80.  
  81.     Application.ScreenUpdating = True
  82.  
  83. [...]
  84. End Sub
 

Je n'ai aucun message d'erreur mais à partir de la ligne 22, le 'travail' n'est pas fait (les lignes que je veux supprimer ne le sont pas et les ajustements graphiques ne sont pas fait) et je ne vois pas ce qui ne va pas.
Une idée ?


Message édité par Takama13 le 10-06-2016 à 16:22:06
mood
Publicité
Posté le 10-06-2016 à 15:13:04  profilanswer
 

n°2284924
Takama13
Posté le 08-07-2016 à 18:34:06  profilanswer
 

Bonjour,
 
Bon, j'ai trouvé les problèmes.
 
1/ La méthode Union fait référence à une application, j'ai donc modifié la ligne 31 en :

Code :
  1. Set RangeToDelete = xlApp.Union(RangeToDelete, xlBook2.Sheets(1).Rows(LinesToDelete(k) + j - 1))


Cette partie fonctionne maintenant
 
2/ J'utilise la propriété "PrintCommunication" pour accélérer mon code. Mais maintenant, avec une autre instance d'Excel, le code entre les lignes 60 et 80 n'est pas pris en compte. Je peux résoudre ce problème en gardant "PrintCommunication" à "True" mais du coup la Macro passe 5mn à effectuer ce petit bout de code. Une solution ?


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA] Travail sur fichier excel en arrière plan

 

Sujets relatifs
quand mouseover texte faire apparaitre une image en arrière planVBA AIDE
Fusion de lignes sur excel[Excel] Création d'une requête SQL ?
Lire un fichier data [resolu, merci]Excel 2010 Touche tab pour passer à la zone de texte suivante
Fermer et Ouvrir le Même fichier sans SourisVBA - format histogramme lié à celulles
[VB/VBA/VBS] Macro excel d’impression sur plusieurs feuilles. 
Plus de sujets relatifs à : [VBA] Travail sur fichier excel en arrière plan


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR