//这个可以运行在Delphi7下，要求安装Excel Xp以上的版本
function TExportData.ReWriteExcelFile(DBGridEh: TDBGridEh;
ExcelFile: string): Boolean;
var
ExcelApplication: TExcelApplication;
ExcelWorksheet: TExcelWorksheet;
ExcelWorkbook: TExcelWorkbook;
CellsVal: TCellsArr;
BCell, ECell: OleVariant;
Titles: TStrings;
i, j, r, c: Integer;
Value, SaveAsFile, ExcelVer: string;
begin
Result := False;
if (not FileExists(ExcelFile)) and (not Assigned(FDBGridEh)) then
Exit;
ExcelApplication := TExcelApplication.Create(nil);
ExcelWorkbook := TExcelWorkbook.Create(nil);
Excelworksheet := TExcelWorksheet.Create(nil);
Titles := TStringList.Create;
ExcelApplication.AutoConnect := False;
ExcelApplication.AutoQuit := True;
ExcelApplication.ConnectKind := ckNewInstance;
try
try
ExcelApplication.Connect; //打开、连接到Excel
try
ExcelApplication.Visible[0]:=False; //Excel表是否可见
ExcelWorkBook.ConnectTo(ExcelApplication.Workbooks.Open(ExcelFile,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,0));
ExcelWorkBook.Activate;
ExcelWorkSheet.ConnectTo(ExcelWorkbook.Worksheets.Item[1] as _WorkSheet);
ExcelWorkSheet.Activate;
ExcelWorkSheet.Columns.AutoFit; //让表格根据内容自适应大小
ExcelWorkSheet.Rows.AutoFit;
SetTitles(Titles);
InitCellsArr(CellsVal, Titles);
if FDBGridEh.UseMultiTitle then //如果FDBGridEh为多表头，则重写多表头的生成
begin
BCell := ExcelWorkSheet.Cells.Item[1, 1];
ECell := ExcelWorkSheet.Cells.Item[1, Titles.Count];
ExcelWorkSheet.Range[BCell, ECell].Clear;
for i:=1 to High(CellsVal)-Low(CellsVal)+1-1-1 do
ExcelWorkSheet.Range[BCell, ECell].Insert(xlShiftDown, EmptyParam); //插入空白行
for i:=Low(CellsVal)+1 to High(CellsVal) do
for j:=Low(CellsVal)+1 to High(CellsVal) do
begin
Value := CellsVal[j];
if Value <> '' then
begin
ExcelWorkSheet.Cells.Item[i, j] := CellsVal[j];
c := j;
r := i;
repeat //横向检查
Inc(c);
until (c>High(CellsVal)) or (CellsVal[c]<>Value) or (CellsVal[c]='');
repeat //纵向检查
Inc(r);
until (r>High(CellsVal)) or (CellsVal[r][j]<>Value) or (CellsVal[r][j]='');
Dec(c); Dec(r);
if (c<>j) or (r<>i) then
begin
ClearCellsRegion(CellsVal, i, j, r, c);
BCell := ExcelWorkSheet.Cells.Item[i, j];
ECell := ExcelWorkSheet.Cells.Item[r, c];
ExcelWorkSheet.Range[BCell, ECell].Merge(False);
ExcelWorkSheet.Range[BCell, ECell].VerticalAlignment := xlCenter;
ExcelWorkSheet.Range[BCell, ECell].HorizontalAlignment := xlCenter;
end;
end; //if
end;
end; //if FDBGridEh.UseMultiTitle
if Caption.Text <> '' then //插入标题
begin
BCell := ExcelWorkSheet.Cells.Item[1, 1]; //<1>
ECell := ExcelWorkSheet.Cells.Item[1, Titles.Count];
ExcelWorkSheet.Range[BCell, ECell].Insert(xlShiftDown, EmptyParam); //插入空白行
ExcelWorkSheet.Range[BCell, ECell].Insert(xlShiftDown, EmptyParam); //插入空白行
ExcelWorkSheet.Cells.Item[1,1] := Caption.Strings[0];
BCell := ExcelWorkSheet.Cells.Item[1, 1]; //此处与<1>不同
ECell := ExcelWorkSheet.Cells.Item[2, Titles.Count];
with ExcelWorkSheet.Range[BCell, BCell].Font do
begin
Name := '宋体';
Size := 20;
Bold := True;
end;
ExcelWorkSheet.Range[BCell, ECell].Merge(False);
ExcelWorkSheet.Range[BCell, ECell].VerticalAlignment := xlCenter;
ExcelWorkSheet.Range[BCell, ECell].HorizontalAlignment := xlCenter;
Caption.Delete(0);
Caption := Caption;
if Caption.Count > 0 then
begin
BCell := ExcelWorkSheet.Cells.Item[3, 1]; //<2>
ECell := ExcelWorkSheet.Cells.Item[3, Titles.Count];
for i:=0 to Caption.Count do //插入的空行比副标题多一行
ExcelWorkSheet.Range[BCell, ECell].Insert(xlShiftDown, EmptyParam); //插入空白行
ExcelWorksheet.Cells.Item[3,1] := Trim(Caption.Text);
BCell := ExcelWorkSheet.Cells.Item[3, 1]; //同样,此处与<2>不同
ECell := ExcelWorkSheet.Cells.Item[Caption.Count+3, Titles.Count];
with ExcelWorkSheet.Range[BCell, ECell].Font do
begin
Name := '宋体';
Size := 11;
Bold := False;
end;
ExcelWorkSheet.Columns.AutoFit;
ExcelWorkSheet.Range[BCell, ECell].Merge(False);
ExcelWorkSheet.Range[BCell, ECell].VerticalAlignment := xlCenter;
ExcelWorkSheet.Range[BCell, ECell].HorizontalAlignment := xlLeft;
end;
end;
ExcelWorkSheet.Columns.AutoFit; //让表格根据内容自适应大小
ExcelWorkSheet.Rows.AutoFit;
ExcelVer := GetExcelVersion; //通过注册表查找Excel的版本
if ExcelVer = '' then
raise Exception.Create(_IDGetVerFailed)
else if GetMainVersion(ExcelVer) < 10 then
raise Exception.Create(_IDVerLow)
else
begin
if GetMainVersion(ExcelVer) < 12 then //12是Excel 2007的版本
ExcelWorkBook.Save
else
begin
SaveAsFile := GetTempFile(ExcelFile);
ExcelWorkSheet.SaveAs(SaveAsFile, 56, '', '', False, False); //56是xlExcel8格式，ExcelXP.pas中尚未声明
CopyFile(PChar(SaveAsFile), PChar(ExcelFile), False);
end;
Result := True;
end;
finally
ExcelWorksheet.Disconnect;
ExcelWorkbook.Disconnect;
ExcelApplication.Disconnect;
ExcelApplication.Quit;
Sleep(500);
if FileExists(SaveAsFile) then
DeleteFile(SaveAsFile);
end;
except
Application.MessageBox(_IDNotInstallExcel, _IDException, MB_OK+MB_ICONERROR);
end;
finally
Titles.Free;
Excelworksheet.Free;
ExcelWorkbook.Free;
ExcelApplication.Free;
end;
end;
