1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
| Option Explicit
Dim appExcel, wBook1, wBook2, Cnt
Dim iRow, Y, RowsCount, ColsCount
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
appExcel.DisplayAlerts = False
' Adapte le chemin des fichiers selon ce que tu as dans la ligne suivante :
Call CopyDataToNewFile("C:\TESTDIR\Temp\Essai1.xlsx", "C:\TESTDIR\Tmp\Essai1.xlsx")
Wscript.Sleep 5000 ' Attente de 5 secondes avant fermeture des fichiers
appExcel.Quit
Set appExcel = Nothing
'===========================
Sub CopyDataToNewFile(XLFile1, XLFile2)
Cnt = 0
iRow = 1
Set WBook1 = appExcel.Workbooks.Open(XLFile1, , True) ' Ouvre le fichier Excel source en lecture seule
appExcel.WorkBooks(1).Activate
RowsCount = WBook1.ActiveSheet.UsedRange.Rows.Count ' Nombre de lignes dans le fichier excel source
ColsCount = WBook1.ActiveSheet.UsedRange.Columns.Count ' Nombre de colonnes dans le fichier excel source
Set wBook2 = appExcel.Workbooks.Add() ' Ouvre un nouveau classeur
Do While iRow < RowsCount+1
Cnt = Cnt + 1
For Y = 1 To ColsCount
' Copie la formule(la valeur s'il n'y a pas de formule)
WBook2.Sheets(1).Cells(Cnt, Y).Formula = WBook1.Sheets(1).Cells(Cnt, Y).Formula
' Copie la taille de la cellule
WBook2.Sheets(1).Columns(cnt).ColumnWidth = WBook1.Sheets(1).Columns(cnt).ColumnWidth
WBook2.Sheets(1).Rows(cnt).RowHeight = WBook1.Sheets(1).Rows(cnt).RowHeight
' Copie la taille et le poids de la police
WBook2.Sheets(1).Cells(Cnt, Y).Font.Size = WBook1.Sheets(1).Cells(Cnt, Y).Font.Size
WBook2.Sheets(1).Cells(Cnt, Y).Font.Bold = WBook1.Sheets(1).Cells(Cnt, Y).Font.Bold
' Mise en forme de la bordure de la cellule
WBook2.Sheets(1).Range("A" & Cstr(iRow) & ":" & Chr(64 + Y) & Cstr(Y)).BorderAround 1, 2, 0
Next
iRow = iRow + 1
Loop
WBook1.Close
WBook2.SaveAs XLFile2, , , , False ' Enregistre le nouveau classeur
End Sub |
Partager