Takama13 | 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 :
- Private Sub Ancienne_Macro()
-
- [...]
- Application.ScreenUpdating = False
-
- Application.Workbooks.Open Filename:=DataServ(i + 1, 2), ReadOnly:=True
- 'Copie dans un nouveau fichier
- Workbooks(Dir(DataServ(i + 1, 2))).Sheets(1).Range("A1:" & DerCol & nLigFin).Copy
- Workbooks.Add
- Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
- Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
-
- 'Suppression des lignes inutiles
- 'Le tableau "LinesToDelete" va chercher la liste des lignes que je veux supprimer dans mon tableau "DataServ"
- LinesToDelete = Split(DataServ(i + 1, 7), "," )
- Application.CutCopyMode = False
- Set RangeToDelete = ActiveSheet.Rows(LinesToDelete(1)) 'je sélectionne la 1ère ligne à supprimer
-
- 'le code ci-dessous permet de sélectionner les autres lignes et de les ajouter les unes aux autres
- For j = 1 To nLigFin Step NbLine
- For k = 0 To UBound(LinesToDelete)
- Set RangeToDelete = Union(RangeToDelete, ActiveSheet.Rows(LinesToDelete(k) + j - 1))
- Next k
- Next j
- 'une fois toutes les lignes sélectionnées, je les supprime
- RangeToDelete.Delete Shift:=xlUp
-
- 'Ajustement graphique
- With ActiveWorkbook
- .Title = ""
- .Subject = ""
- .Author = ""
- .Keywords = ""
- .Comments = ""
- End With
-
- With Application
- .Calculation = xlAutomatic
- .MaxChange = 0.001
- End With
-
- ActiveWorkbook.PrecisionAsDisplayed = False
-
- With ActiveSheet.PageSetup
- .PrintTitleRows = ""
- .PrintTitleColumns = ""
- End With
-
- [...]
-
- Application.PrintCommunication = False
- With ActiveSheet.PageSetup
- .PrintArea = "$A$1:" & DerCol & nLigFin
- .LeftMargin = Application.InchesToPoints(0.177165354330709)
- .RightMargin = Application.InchesToPoints(0.177165354330709)
- .TopMargin = Application.InchesToPoints(0.708661417322835)
- .BottomMargin = Application.InchesToPoints(0.354330708661417)
- .HeaderMargin = Application.InchesToPoints(0)
- .FooterMargin = Application.InchesToPoints(0.196850393700787)
- .PrintHeadings = False
- .PrintGridlines = False
- .PrintComments = xlPrintNoComments
- .CenterHorizontally = True
- .CenterVertically = True
- .Orientation = PrintOrientation
- .Draft = False
- .PaperSize = xlPaperA4
- .FirstPageNumber = xlAutomatic
- .Order = xlDownThenOver
- .BlackAndWhite = False
- .Zoom = False
- .FitToPagesWide = 1
- .FitToPagesTall = 1
- End With
- Application.PrintCommunication = True
-
- Application.ScreenUpdating = True
-
- [...]
- End Sub
| Pour travailler en arrière plan, je travaille sur une nouvelle instance d'Excel. Ma nouvelle macro : Code :
- Option Base 1
- Dim xlApp As New Excel.Application
- Dim xlBook, xlBook2 As New Excel.Workbook
- Dim xlSheet As New Excel.Worksheet
- Private Sub Nouvelle_Macro()
-
- [...]
- Application.ScreenUpdating = False
-
- Set xlBook = xlApp.Workbooks.Open(Filename:=DataServ(i + 1, 2), ReadOnly:=True)
- 'Copie dans un nouveau fichier
- Set xlBook2 = xlApp.Workbooks.Add
- xlBook.Sheets(1).Range("A1:" & DerCol & nLigFin).Copy
- With xlBook2.Sheets(1).Range("A1" )
- .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
- .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
- End With
-
- 'Suppression des lignes inutiles
- 'Le tableau "LinesToDelete" va chercher la liste des lignes que je veux supprimer dans mon tableau "DataServ"
- LinesToDelete = Split(DataServ(i + 1, 7), "," ) 'Chargement des lignes à supprimer
- xlApp.CutCopyMode = False
- Set RangeToDelete = xlBook2.Sheets(1).Rows(LinesToDelete(1)) 'je sélectionne la 1ère ligne à supprimer
-
- 'le code ci-dessous permet de sélectionner les autres lignes et de les ajouter les unes aux autres
- For j = 1 To nLigFin Step NbLine
- For k = 0 To UBound(LinesToDelete)
- Set RangeToDelete = Union(RangeToDelete, xlBook2.Sheets(1).Rows(LinesToDelete(k) + j - 1))
- Next k
- Next j
- 'une fois toutes les lignes sélectionnées, je les supprime
- RangeToDelete.Delete Shift:=xlUp
-
- 'Ajustement graphique
- With xlBook2
- .Title = ""
- .Subject = ""
- .Author = ""
- .Keywords = ""
- .Comments = ""
- End With
-
- With xlApp
- .Calculation = xlAutomatic
- .MaxChange = 0.001
- End With
-
- xlBook2.PrecisionAsDisplayed = False
-
- With xlBook2.Sheets(1).PageSetup
- .PrintTitleRows = ""
- .PrintTitleColumns = ""
- End With
-
- xlApp.PrintCommunication = False
- With xlBook2.Sheets(1).PageSetup
- .PrintArea = "$A$1:" & DerCol & nLigFin
- .LeftMargin = Application.InchesToPoints(0.177165354330709)
- .RightMargin = Application.InchesToPoints(0.177165354330709)
- .TopMargin = Application.InchesToPoints(0.708661417322835)
- .BottomMargin = Application.InchesToPoints(0.354330708661417)
- .HeaderMargin = Application.InchesToPoints(0)
- .FooterMargin = Application.InchesToPoints(0.196850393700787)
- .PrintHeadings = False
- .PrintGridlines = False
- .PrintComments = xlPrintNoComments
- .CenterHorizontally = True
- .CenterVertically = True
- .Orientation = PrintOrientation
- .Draft = False
- .PaperSize = xlPaperA4
- .FirstPageNumber = xlAutomatic
- .Order = xlDownThenOver
- .BlackAndWhite = False
- .Zoom = False
- .FitToPagesWide = 1
- .FitToPagesTall = 1
- End With
- xlApp.PrintCommunication = True
-
- Application.ScreenUpdating = True
-
- [...]
- 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
|