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

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.093 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR