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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{************************************************************************}
{****** PROCEDURES ET FONCTIONS POUR L'EXPORTATION VERS EXCEL ******}
{************************************************************************}
function RefToCell(RowID, ColID: Integer): string;
var
ACount, APos: Integer;
begin
ACount := ColID div 26;
APos := ColID mod 26;
if APos = 0 then
begin
ACount := ACount - 1;
APos := 26;
end;
if ACount = 0 then
Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
if ACount = 1 then
Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
if ACount > 1 then
Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) +
IntToStr(RowID);
end;
//Exportation du contenu du StringGrid vers Excel
function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: OLEVariant;
I, J, N, M: Integer;
SaveFileName : String;
begin
//calcule la quantité de feuilles nécessaires
SheetCount := (Grid.ColCount div 256) + 1;
if Grid.ColCount mod 256 = 0 then
SheetCount := SheetCount - 1;
//calcule la quantité de classeurs nécessaires
BookCount := (Grid.RowCount div 65536) + 1;
if Grid.RowCount mod 65536 = 0 then
BookCount := BookCount - 1;
//Creation d'Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
//pointe sur la feuille excel
if ShowExcel = false then
XLApp.Visible := False
else
XLApp.Visible := True;
//ajout Workbook
for M := 1 to BookCount do
begin
XLApp.Workbooks.Add(xlWBATWorksheet);
//place les feuilles
for N := 1 to SheetCount - 1 do
begin
XLApp.Worksheets.Add;
end;
end;
//ajoute les colonnes
if Grid.ColCount <= 256 then SheetColCount := Grid.ColCount
else SheetColCount := 256;
//ajoute les lignes
if Grid.RowCount <= 65536 then SheetRowCount := Grid.RowCount
else SheetRowCount := 65536;
//remplissage de la feuille
for M := 1 to BookCount do
begin
for N := 1 to SheetCount do
begin
//va chercher les data
Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
for I := 0 to SheetColCount - 1 do
for J := 0 to SheetRowCount - 1 do
if ((I+256*(N-1)) <= Grid.ColCount) and ((J+65536*(M-1)) <= Grid.RowCount) then
Data[J + 1, I + 1] := Grid.Cells[I+256*(N-1), J+65536*(M-1)];
XLApp.Worksheets[N].Select;
XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
//formate les cellules en string
XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1), RefToCell(SheetRowCount,
SheetColCount)].Select;
XLApp.Selection.NumberFormat := '@';
XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
//remet les données en place
Sheet := XLApp.Workbooks[M].WorkSheets[N];
Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Value := Data;
end;
end;
//Enregistre le classeur excel
try
for M := 1 to BookCount do
begin
//rajoute le numéro du classeur dans le nom de fichier choisi
SaveFileName := Copy(FileName,1,Pos('.',FileName)-1) + IntToStr(M) +
Copy(FileName,Pos('.',FileName),
Length(FileName)-Pos('.',FileName)+1);
XLApp.Workbooks[M].SaveAs(SaveFileName);
end;
Result := True;
except
// Error?
end;
finally
//Excel termine
if (not VarIsEmpty(XLApp)) and (ShowExcel = false) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end; |
