一个通用的Delphi数据导出到Excel函数
关键字：delphi 对Excel编程，TDataSet（Tquery，TTabe）导到Excel，如何设置Excel字体、文本对齐方式，如何设置单元格边框，如何合并单元格，如何Excel打印设置，如何设置单元格为文本格式
主要功能：
1.数据集导出到Excel函数
2.自动设置列宽
3.自动调节适应A4纸张
4.具有打开Excel、打印预览、直接打印选项
unit ExcelReport;
interface
uses
SysUtils, Variants, Controls, Forms, Dialogs, ComObj, ComCtrls, DB, excel2000,
StdCtrls, Graphics, Windows, Grids;
SysUtils, Variants, Controls, Forms, Dialogs, ComObj, ComCtrls, DB, excel2000,
StdCtrls, Graphics, Windows, Grids;
{**************************************************************************************
数据集导出到Excel函数，自动设置列宽，自动调节适应A4纸张
Columns：可以是DataSet的Fields，ListView的Columns，StringGrid之一
DataSet：数据集
Caption：大标题，
SubCaption：子标题，
LeftCaption：左标题，
CenterCaption：中标题
RightCaption：右标题
Flag：1:预览，2:直接打印，0：打开Excel编辑
ColAutoSize：是否允许自动列宽
**************************************************************************************}
数据集导出到Excel函数，自动设置列宽，自动调节适应A4纸张
Columns：可以是DataSet的Fields，ListView的Columns，StringGrid之一
DataSet：数据集
Caption：大标题，
SubCaption：子标题，
LeftCaption：左标题，
CenterCaption：中标题
RightCaption：右标题
Flag：1:预览，2:直接打印，0：打开Excel编辑
ColAutoSize：是否允许自动列宽
**************************************************************************************}
procedure DataSetToExcel(Columns: TObject; DataSet: TDataSet; Caption: String = '';
SubCaption: String = ''; LeftCaption: String = '';
CenterCaption: String = ''; RightCaption: String = '';
Flag: Integer = 1; ColAutoSize: Boolean = True);
SubCaption: String = ''; LeftCaption: String = '';
CenterCaption: String = ''; RightCaption: String = '';
Flag: Integer = 1; ColAutoSize: Boolean = True);
implementation
procedure DataSetToExcel(Columns: TObject; DataSet: TDataSet; Caption: String = '';
SubCaption: String = ''; LeftCaption: String = '';
CenterCaption: String = ''; RightCaption: String = '';
Flag: Integer = 1; ColAutoSize: Boolean = True);
const
MaxColWidth = 80;
RowCaption = 1;
RowUse = 5;
SubCaption: String = ''; LeftCaption: String = '';
CenterCaption: String = ''; RightCaption: String = '';
Flag: Integer = 1; ColAutoSize: Boolean = True);
const
MaxColWidth = 80;
RowCaption = 1;
RowUse = 5;
FontSizeCaption = 15;
FontSizeSubCaption = 10;
FontSizeLeftCaption = 12;
FontSizeCenterCaption = 12;
FontSizeRightCaption = 12;
FontSizeColumns = 10;
FontSizeData = 10;
FontSizeSubCaption = 10;
FontSizeLeftCaption = 12;
FontSizeCenterCaption = 12;
FontSizeRightCaption = 12;
FontSizeColumns = 10;
FontSizeData = 10;
FontNameCaption = '楷体';
FontNameSubCaption = '宋体';
FontNameLeftCaption = '宋体';
FontNameCenterCaption = '宋体';
FontNameRightCaption = '宋体';
FontNameColumns = '宋体';
FontNameData = '宋体';
FontNameSubCaption = '宋体';
FontNameLeftCaption = '宋体';
FontNameCenterCaption = '宋体';
FontNameRightCaption = '宋体';
FontNameColumns = '宋体';
FontNameData = '宋体';
TextAlignLeft = 2;
TextAlignCenter = 3;
TextAlignRight = 4;
TextAlignCenter = 3;
TextAlignRight = 4;
TextAlignTop = 1;
TextAlignVCenter = 2;
TextAlignBottom = 3;
var
Excel, Sheet: Variant;
RowIndex: Integer;
ColSum: Integer;
Form: TForm;
lb: TLabel;
function GetExcel(): Integer;
begin
Result := DataSet.RecordCount + RowUse;
if (Result > 65536 ) then
begin
if (MessageDlg(' 需要导出的数据过大，Excel最大只能容纳65536行，'+
#13'将会截断超过部分，是否还要继续？',
mtConfirmation, [mbYes, mbNo], 0) = mrNo) then
begin
Result := 0;
exit;
end else
Result := 65536;
end;
try
Excel := CreateOleobject('Excel.Application');
except
ShowMessage(#13' Excel没有正确安装！');
end;
end;
TextAlignVCenter = 2;
TextAlignBottom = 3;
var
Excel, Sheet: Variant;
RowIndex: Integer;
ColSum: Integer;
Form: TForm;
lb: TLabel;
function GetExcel(): Integer;
begin
Result := DataSet.RecordCount + RowUse;
if (Result > 65536 ) then
begin
if (MessageDlg(' 需要导出的数据过大，Excel最大只能容纳65536行，'+
#13'将会截断超过部分，是否还要继续？',
mtConfirmation, [mbYes, mbNo], 0) = mrNo) then
begin
Result := 0;
exit;
end else
Result := 65536;
end;
try
Excel := CreateOleobject('Excel.Application');
except
ShowMessage(#13' Excel没有正确安装！');
end;
end;
function GetColumnsWidth(): Integer;
var
i: Integer;
begin
Result := 0;
for i := 1 to ColSum do
Result := Result + Sheet.Columns[i].ColumnWidth;
Result := Excel.InchesToPoints((Result * 2.2862) / 25.4);
end;
var
i: Integer;
begin
Result := 0;
for i := 1 to ColSum do
Result := Result + Sheet.Columns[i].ColumnWidth;
Result := Excel.InchesToPoints((Result * 2.2862) / 25.4);
end;
procedure SetColumns( Columns: TListColumns); overload;
var
i: Integer;
s: String;
begin
for i := 0 to (Columns.Count - 1) do
begin
s := Columns[i].Caption;
Sheet.Columns[i + 1].ColumnWidth := Length(s);
Sheet.Cells[RowIndex, i + 1].value := s;
end;
end;
var
i: Integer;
s: String;
begin
for i := 0 to (Columns.Count - 1) do
begin
s := Columns[i].Caption;
Sheet.Columns[i + 1].ColumnWidth := Length(s);
Sheet.Cells[RowIndex, i + 1].value := s;
end;
end;
procedure SetColumns( Columns: TFields); overload;
var
i: Integer;
s: String;
begin
for i := 0 to (Columns.Count - 1) do
begin
s := Columns[i].FieldName;
Sheet.Columns[i + 1].ColumnWidth := Length(s);
Sheet.Cells[RowIndex, i + 1].value := s;
end;
end;
var
i: Integer;
s: String;
begin
for i := 0 to (Columns.Count - 1) do
begin
s := Columns[i].FieldName;
Sheet.Columns[i + 1].ColumnWidth := Length(s);
Sheet.Cells[RowIndex, i + 1].value := s;
end;
end;
procedure SetColumns( Columns: TStringGrid); overload;
var
i: Integer;
s: String;
begin
for i := 1 to (Columns.ColCount - 1) do
begin
s := Columns.Cells[i, 0];
Sheet.Columns[i].ColumnWidth := Length(s);
Sheet.Cells[RowIndex, i].value := s;
end;
end;
var
i: Integer;
s: String;
begin
for i := 1 to (Columns.ColCount - 1) do
begin
s := Columns.Cells[i, 0];
Sheet.Columns[i].ColumnWidth := Length(s);
Sheet.Cells[RowIndex, i].value := s;
end;
end;
procedure DoDataSetToExcel();
function GetDateTimeStr(DT: TDateTime): String;
var
nDT: Integer;
begin
Result := TimeToStr(DT);
nDT := Trunc(DT);
if nDT < 1000 then
begin
if nDT - 2 >= 1 then
Result := IntToStr(nDT - 2) + '天' + Result;
end else
Result := DateToStr(DT) + ' ' + Result;
end;
var
i, RowEnd, Len: Integer;
s: String;
begin
RowEnd := DataSet.RecordCount + RowIndex - 1;
if RowEnd > 65536 then
RowEnd := 65536;
DataSet.First();
while not DataSet.Eof do
begin
for i := 0 to DataSet.Fields.Count - 1 do
begin
if DataSet.Fields[i].DataType in [ftDateTime, ftDate, ftTime] then
begin
if DataSet.Fields[i].IsNull then
s := ''
else
s := GetDateTimeStr(DataSet.Fields[i].AsDateTime);
end else
s := DataSet.Fields[i].AsString;
if ColAutoSize then
begin
Len := Length(s) - 1;
if Len > MaxColWidth then
Len := MaxColWidth;
if Sheet.Columns[i + 1].ColumnWidth < Len then
Sheet.Columns[i + 1].ColumnWidth := Len;
end;
Sheet.Cells[RowIndex, i + 1].value := s;
end;
if RowIndex = RowEnd then
break;
if RowIndex mod 10 = 0 then
begin
lb.Caption := Format('正在导出数据，已经完成：%d', [Trunc(RowIndex / RowEnd * 100)]) + '%';
Form.Update();
Application.ProcessMessages();
end;
RowIndex := RowIndex + 1;
DataSet.Next();
end;
lb.Caption := '数据导出完毕......';
Form.Update();
end;
function GetDateTimeStr(DT: TDateTime): String;
var
nDT: Integer;
begin
Result := TimeToStr(DT);
nDT := Trunc(DT);
if nDT < 1000 then
begin
if nDT - 2 >= 1 then
Result := IntToStr(nDT - 2) + '天' + Result;
end else
Result := DateToStr(DT) + ' ' + Result;
end;
var
i, RowEnd, Len: Integer;
s: String;
begin
RowEnd := DataSet.RecordCount + RowIndex - 1;
if RowEnd > 65536 then
RowEnd := 65536;
DataSet.First();
while not DataSet.Eof do
begin
for i := 0 to DataSet.Fields.Count - 1 do
begin
if DataSet.Fields[i].DataType in [ftDateTime, ftDate, ftTime] then
begin
if DataSet.Fields[i].IsNull then
s := ''
else
s := GetDateTimeStr(DataSet.Fields[i].AsDateTime);
end else
s := DataSet.Fields[i].AsString;
if ColAutoSize then
begin
Len := Length(s) - 1;
if Len > MaxColWidth then
Len := MaxColWidth;
if Sheet.Columns[i + 1].ColumnWidth < Len then
Sheet.Columns[i + 1].ColumnWidth := Len;
end;
Sheet.Cells[RowIndex, i + 1].value := s;
end;
if RowIndex = RowEnd then
break;
if RowIndex mod 10 = 0 then
begin
lb.Caption := Format('正在导出数据，已经完成：%d', [Trunc(RowIndex / RowEnd * 100)]) + '%';
Form.Update();
Application.ProcessMessages();
end;
RowIndex := RowIndex + 1;
DataSet.Next();
end;
lb.Caption := '数据导出完毕......';
Form.Update();
end;
function RowColToStr( R1, C1, R2, C2: Integer): String;
function ColToStr(C: Integer): String;
var
nDiv: Integer;
begin
Result := '';
if C > 26 then
begin
nDiv := C div 26;
C := (C mod 26);
if C = 0 then
begin
C := 26;
nDiv := nDiv - 1;
end;
Result := Char(Integer('A') + nDiv);
end;
Result := Result + Char(Integer('A') + C - 1);
end;
begin
Result := ColToStr(C1) + IntToStr(R1) + ':' + ColToStr(C2) + IntToStr(R2);
end;
function ColToStr(C: Integer): String;
var
nDiv: Integer;
begin
Result := '';
if C > 26 then
begin
nDiv := C div 26;
C := (C mod 26);
if C = 0 then
begin
C := 26;
nDiv := nDiv - 1;
end;
Result := Char(Integer('A') + nDiv);
end;
Result := Result + Char(Integer('A') + C - 1);
end;
begin
Result := ColToStr(C1) + IntToStr(R1) + ':' + ColToStr(C2) + IntToStr(R2);
end;
var
Range, RangeFind: Variant;
RowEnd: Integer;
function RepString(FindStr, ReplacedStr: String): Boolean;
begin
Result := False;
RangeFind := Excel.Cells.Find(FindStr, EmptyParam, xlFormulas, xlPart, xlByRows, xlNext, False, False);
try
RowIndex := RangeFind.Row;
RangeFind.Select;
Excel.ActiveCell.value := ReplacedStr;
Result := True;
except
end;
end;
Range, RangeFind: Variant;
RowEnd: Integer;
function RepString(FindStr, ReplacedStr: String): Boolean;
begin
Result := False;
RangeFind := Excel.Cells.Find(FindStr, EmptyParam, xlFormulas, xlPart, xlByRows, xlNext, False, False);
try
RowIndex := RangeFind.Row;
RangeFind.Select;
Excel.ActiveCell.value := ReplacedStr;
Result := True;
except
end;
end;
procedure SetFormat();
var
i: Integer;
begin
for i := 0 to DataSet.Fields.Count - 1 do
begin
case DataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint:
begin
Range := Sheet.Range[RowColToStr(RowIndex, i + 1, RowEnd, i + 1)];
Range.HorizontalAlignment := TextAlignRight;
//Range.NumberFormat := '#,##0;-#,##0';
end;
ftFloat:
begin
Range := Sheet.Range[RowColToStr(RowIndex, i + 1, RowEnd, i + 1)];
Range.HorizontalAlignment := TextAlignRight;
Range.NumberFormat := '#,##0.000000;-#,##0.00000';
end;
ftDate, ftTime, ftDateTime:
begin
Range := Sheet.Range[RowColToStr(RowIndex, i + 1, RowEnd, i + 1)];
Range.HorizontalAlignment := TextAlignRight;
Range.NumberFormatLocal := '@';
if DataSet.Fields[i].AsDateTime < 1000 then
Sheet.Columns[i + 1].ColumnWidth := 9.1
else
Sheet.Columns[i + 1].ColumnWidth := 17;
end;
end;
end;
end;
var
i: Integer;
begin
for i := 0 to DataSet.Fields.Count - 1 do
begin
case DataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint:
begin
Range := Sheet.Range[RowColToStr(RowIndex, i + 1, RowEnd, i + 1)];
Range.HorizontalAlignment := TextAlignRight;
//Range.NumberFormat := '#,##0;-#,##0';
end;
ftFloat:
begin
Range := Sheet.Range[RowColToStr(RowIndex, i + 1, RowEnd, i + 1)];
Range.HorizontalAlignment := TextAlignRight;
Range.NumberFormat := '#,##0.000000;-#,##0.00000';
end;
ftDate, ftTime, ftDateTime:
begin
Range := Sheet.Range[RowColToStr(RowIndex, i + 1, RowEnd, i + 1)];
Range.HorizontalAlignment := TextAlignRight;
Range.NumberFormatLocal := '@';
if DataSet.Fields[i].AsDateTime < 1000 then
Sheet.Columns[i + 1].ColumnWidth := 9.1
else
Sheet.Columns[i + 1].ColumnWidth := 17;
end;
end;
end;
end;
procedure CheckPageWidth();
var
PageW, WordW, BorderMargin: Integer;
tmp: Integer;
i: Integer;
ftmp: real;
begin
if (xlPaperA4 = Sheet.PageSetup.PaperSize) and (xlPortrait = Sheet.PageSetup.Orientation) then
begin
BorderMargin := Sheet.PageSetup.LeftMargin * 2;
WordW := GetColumnsWidth();
PageW := Excel.InchesToPoints(21 / 2.54);
if WordW > PageW - BorderMargin then
begin
Sheet.PageSetup.Orientation := xlLandscape;
PageW := Excel.InchesToPoints(29.7 / 2.54);
tmp := PageW - WordW - BorderMargin;
ftmp := tmp / WordW;
if (tmp < 0) and (ftmp >= -0.15) then
begin
ftmp := 1 + ftmp;
for i := 1 to ColSum do
Sheet.Columns[i].ColumnWidth := Sheet.Columns[i].ColumnWidth * ftmp;
end;
end;
end;
end;
var
PageW, WordW, BorderMargin: Integer;
tmp: Integer;
i: Integer;
ftmp: real;
begin
if (xlPaperA4 = Sheet.PageSetup.PaperSize) and (xlPortrait = Sheet.PageSetup.Orientation) then
begin
BorderMargin := Sheet.PageSetup.LeftMargin * 2;
WordW := GetColumnsWidth();
PageW := Excel.InchesToPoints(21 / 2.54);
if WordW > PageW - BorderMargin then
begin
Sheet.PageSetup.Orientation := xlLandscape;
PageW := Excel.InchesToPoints(29.7 / 2.54);
tmp := PageW - WordW - BorderMargin;
ftmp := tmp / WordW;
if (tmp < 0) and (ftmp >= -0.15) then
begin
ftmp := 1 + ftmp;
for i := 1 to ColSum do
Sheet.Columns[i].ColumnWidth := Sheet.Columns[i].ColumnWidth * ftmp;
end;
end;
end;
end;
var
Workbook: Variant;
CursorSave: TCursor;
ColCenter: Integer;
FileName: String;
begin
ColSum := DataSet.Fields.Count;
if ColSum = 0 then
begin
ShowMessage(#13' 数据表的列数为0，无法导出！');
exit;
end;
CursorSave := Screen.Cursor;
Form := TForm.Create(nil);
Form.BorderStyle := bsNone;
Form.FormStyle := fsStayOnTop;
Form.Width := 300;
Form.Height := 90;
Form.Left := (Screen.Width - Form.Width) div 2;
Form.Top := (Screen.Height - Form.Height) div 2;
lb := TLabel.Create(Form);
lb.Parent := Form;
lb.AutoSize := False;
lb.Left := 5;
lb.Top := 35;
lb.Width := 290;
lb.Height := 30;
lb.Font.Size := 10;
lb.Font.Color := clBlue;
Workbook: Variant;
CursorSave: TCursor;
ColCenter: Integer;
FileName: String;
begin
ColSum := DataSet.Fields.Count;
if ColSum = 0 then
begin
ShowMessage(#13' 数据表的列数为0，无法导出！');
exit;
end;
CursorSave := Screen.Cursor;
Form := TForm.Create(nil);
Form.BorderStyle := bsNone;
Form.FormStyle := fsStayOnTop;
Form.Width := 300;
Form.Height := 90;
Form.Left := (Screen.Width - Form.Width) div 2;
Form.Top := (Screen.Height - Form.Height) div 2;
lb := TLabel.Create(Form);
lb.Parent := Form;
lb.AutoSize := False;
lb.Left := 5;
lb.Top := 35;
lb.Width := 290;
lb.Height := 30;
lb.Font.Size := 10;
lb.Font.Color := clBlue;
Form.Show();
try
Screen.Cursor := crHourGlass;
lb.Caption := '正在创建Excel......';
Form.Update();
RowEnd := GetExcel();
if RowEnd > 0 then
begin
try
try
lb.Caption := '正在打开Excel......';
Form.Update();
FileName := ExtractFileDir(Application.ExeName) + '\' + Caption + '_模板.xls';
if FileExists(FileName) then
begin
FileName := ExtractFileDir(Application.ExeName) + '\' + Caption + '.xls';
CopyFile(PChar(ExtractFileDir(Application.ExeName) + '\' + Caption + '_模板.xls'), PChar(FileName), False) ;
end else
FileName := '';
if FileName <> '' then
begin
Workbook := Excel.Workbooks.Open(FileName)
end else
begin
Workbook := Excel.Workbooks.Add;
Excel.WorkSheets[1].Name := Caption;
end;
Excel.WorkSheets[1].Activate;
Sheet := Excel.Workbooks[1].WorkSheets[1];
Sheet.Cells.NumberFormatLocal := '@';
RowIndex := RowCaption;
ColCenter := (ColSum + 1) div 2;
try
Screen.Cursor := crHourGlass;
lb.Caption := '正在创建Excel......';
Form.Update();
RowEnd := GetExcel();
if RowEnd > 0 then
begin
try
try
lb.Caption := '正在打开Excel......';
Form.Update();
FileName := ExtractFileDir(Application.ExeName) + '\' + Caption + '_模板.xls';
if FileExists(FileName) then
begin
FileName := ExtractFileDir(Application.ExeName) + '\' + Caption + '.xls';
CopyFile(PChar(ExtractFileDir(Application.ExeName) + '\' + Caption + '_模板.xls'), PChar(FileName), False) ;
end else
FileName := '';
if FileName <> '' then
begin
Workbook := Excel.Workbooks.Open(FileName)
end else
begin
Workbook := Excel.Workbooks.Add;
Excel.WorkSheets[1].Name := Caption;
end;
Excel.WorkSheets[1].Activate;
Sheet := Excel.Workbooks[1].WorkSheets[1];
Sheet.Cells.NumberFormatLocal := '@';
RowIndex := RowCaption;
ColCenter := (ColSum + 1) div 2;
lb.Caption := '正在设置标题......';
Form.Update();
Sheet.Range['A1:A1'].Select;
if Caption <> '' then
begin
//设置标题
if (FileName = '') or (not RepString('%标题%', Caption)) then
begin
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, ColSum)];
Range.NumberFormatLocal := '@';
Range.HorizontalAlignment := TextAlignCenter;
Range.VerticalAlignment := TextAlignVCenter;
Range.Characters.Font.Name := FontNameCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeCaption;
Sheet.Cells[RowIndex, ColCenter].value := Caption;
Range.Merge;
end;
end;
Form.Update();
Sheet.Range['A1:A1'].Select;
if Caption <> '' then
begin
//设置标题
if (FileName = '') or (not RepString('%标题%', Caption)) then
begin
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, ColSum)];
Range.NumberFormatLocal := '@';
Range.HorizontalAlignment := TextAlignCenter;
Range.VerticalAlignment := TextAlignVCenter;
Range.Characters.Font.Name := FontNameCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeCaption;
Sheet.Cells[RowIndex, ColCenter].value := Caption;
Range.Merge;
end;
end;
if SubCaption <> '' then
begin
//设置子标题
if (FileName = '') or (not RepString('%子标题%', SubCaption)) then
begin
RowIndex := RowIndex + 1;
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, ColSum)];
Range.HorizontalAlignment := TextAlignCenter;
Range.VerticalAlignment := TextAlignTop;
Range.Characters.Font.Name := FontNameSubCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeSubCaption;
Sheet.Cells[RowIndex, ColCenter].value := SubCaption;
Range.Merge; //合并
RowIndex := RowIndex + 1;
end;
end;
begin
//设置子标题
if (FileName = '') or (not RepString('%子标题%', SubCaption)) then
begin
RowIndex := RowIndex + 1;
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, ColSum)];
Range.HorizontalAlignment := TextAlignCenter;
Range.VerticalAlignment := TextAlignTop;
Range.Characters.Font.Name := FontNameSubCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeSubCaption;
Sheet.Cells[RowIndex, ColCenter].value := SubCaption;
Range.Merge; //合并
RowIndex := RowIndex + 1;
end;
end;
if (FileName = '') then
begin
Sheet.Rows[Format('%d:%d', [RowIndex, RowIndex])].Select;
Excel.Selection.RowHeight := 8;
RowIndex := RowIndex + 1;
end;
begin
Sheet.Rows[Format('%d:%d', [RowIndex, RowIndex])].Select;
Excel.Selection.RowHeight := 8;
RowIndex := RowIndex + 1;
end;
if LeftCaption <> '' then
begin
//设置左标题
if (FileName = '') or (not RepString('%左标题%', LeftCaption)) then
begin
//设置左标题
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, 1)];
Range.HorizontalAlignment := TextAlignLeft;
Range.Characters.Font.Name := FontNameLeftCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeLeftCaption;
Sheet.Cells[RowIndex, 1].value := LeftCaption;
end;
end;
begin
//设置左标题
if (FileName = '') or (not RepString('%左标题%', LeftCaption)) then
begin
//设置左标题
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, 1)];
Range.HorizontalAlignment := TextAlignLeft;
Range.Characters.Font.Name := FontNameLeftCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeLeftCaption;
Sheet.Cells[RowIndex, 1].value := LeftCaption;
end;
end;
if CenterCaption <> '' then
begin
//设置中标题
if (FileName = '') or (not RepString('%中标题%', CenterCaption)) then
begin
Range := Sheet.Range[RowColToStr(RowIndex, ColCenter, RowIndex, ColCenter)];
Range.HorizontalAlignment := TextAlignCenter;
Range.Characters.Font.Name := FontNameCenterCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeCenterCaption;
Sheet.Cells[RowIndex, ColCenter].value := CenterCaption;
end;
end;
begin
//设置中标题
if (FileName = '') or (not RepString('%中标题%', CenterCaption)) then
begin
Range := Sheet.Range[RowColToStr(RowIndex, ColCenter, RowIndex, ColCenter)];
Range.HorizontalAlignment := TextAlignCenter;
Range.Characters.Font.Name := FontNameCenterCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeCenterCaption;
Sheet.Cells[RowIndex, ColCenter].value := CenterCaption;
end;
end;
if RightCaption <> '' then
begin
//设置右标题
if (FileName = '') or (not RepString('%右标题%', RightCaption)) then
begin
Range := Sheet.Range[RowColToStr(RowIndex, ColSum, RowIndex, ColSum)];
Range.HorizontalAlignment := TextAlignRight;
Range.Characters.Font.Name := FontNameRightCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeRightCaption;
Sheet.Cells[RowIndex, ColSum].value := RightCaption;
end;
end;
begin
//设置右标题
if (FileName = '') or (not RepString('%右标题%', RightCaption)) then
begin
Range := Sheet.Range[RowColToStr(RowIndex, ColSum, RowIndex, ColSum)];
Range.HorizontalAlignment := TextAlignRight;
Range.Characters.Font.Name := FontNameRightCaption;
Range.Characters.Font.FontStyle := '加粗';
Range.Characters.Font.Size := FontSizeRightCaption;
Sheet.Cells[RowIndex, ColSum].value := RightCaption;
end;
end;
if RowIndex <> RowCaption then
RowIndex := RowIndex + 1;
RowIndex := RowIndex + 1;
//设置栏目字体
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, ColSum)];
Range.Select;
if (FileName <> '') and RepString('%栏目%', '') then
begin
Range.Characters.Font.Name := RangeFind.Characters.Font.Name;
Range.Characters.Font.Size := RangeFind.Characters.Font.Size;
Range.HorizontalAlignment := RangeFind.HorizontalAlignment;
Range.Characters.Font.FontStyle := RangeFind.Characters.Font.FontStyle;
Range.Borders[1].Weight := RangeFind.Borders[1].Weight;
Range.Borders[2].Weight := RangeFind.Borders[2].Weight;
Range.Borders[3].Weight := RangeFind.Borders[3].Weight;
Range.Borders[4].Weight := RangeFind.Borders[4].Weight;
end else
begin
Range.Characters.Font.Name := FontNameColumns;
Range.Characters.Font.Size := FontSizeColumns;
Range.HorizontalAlignment := TextAlignCenter;
Range.Characters.Font.FontStyle := '加粗';
Range.Borders[1].Weight := 2;
Range.Borders[2].Weight := 2;
Range.Borders[3].Weight := 2;
Range.Borders[4].Weight := 2;
end;
Sheet.PageSetup.PrintTitleRows := Format('$%d:$%d', [RowIndex, RowIndex]);
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowIndex, ColSum)];
Range.Select;
if (FileName <> '') and RepString('%栏目%', '') then
begin
Range.Characters.Font.Name := RangeFind.Characters.Font.Name;
Range.Characters.Font.Size := RangeFind.Characters.Font.Size;
Range.HorizontalAlignment := RangeFind.HorizontalAlignment;
Range.Characters.Font.FontStyle := RangeFind.Characters.Font.FontStyle;
Range.Borders[1].Weight := RangeFind.Borders[1].Weight;
Range.Borders[2].Weight := RangeFind.Borders[2].Weight;
Range.Borders[3].Weight := RangeFind.Borders[3].Weight;
Range.Borders[4].Weight := RangeFind.Borders[4].Weight;
end else
begin
Range.Characters.Font.Name := FontNameColumns;
Range.Characters.Font.Size := FontSizeColumns;
Range.HorizontalAlignment := TextAlignCenter;
Range.Characters.Font.FontStyle := '加粗';
Range.Borders[1].Weight := 2;
Range.Borders[2].Weight := 2;
Range.Borders[3].Weight := 2;
Range.Borders[4].Weight := 2;
end;
Sheet.PageSetup.PrintTitleRows := Format('$%d:$%d', [RowIndex, RowIndex]);
lb.Caption := '正在设置栏目和数据区字体......';
Form.Update();
//设置栏目文字
if Columns is TFields then
SetColumns(TFields(Columns))
else
if Columns is TStringGrid then
SetColumns(TStringGrid(Columns))
else
if Columns is TListColumns then
SetColumns(TListColumns(Columns));
RowIndex := RowIndex + 1;
Form.Update();
//设置栏目文字
if Columns is TFields then
SetColumns(TFields(Columns))
else
if Columns is TStringGrid then
SetColumns(TStringGrid(Columns))
else
if Columns is TListColumns then
SetColumns(TListColumns(Columns));
RowIndex := RowIndex + 1;
//设置数据字体
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowEnd, ColSum)];
Range.Select;
if (FileName <> '') and RepString('%数据%', '') then
begin
Range.Characters.Font.Name := RangeFind.Characters.Font.Name;
Range.Characters.Font.Size := RangeFind.Characters.Font.Size;
Range.HorizontalAlignment := RangeFind.HorizontalAlignment;
Range.Characters.Font.FontStyle := RangeFind.Characters.Font.FontStyle;
Range.Borders[1].Weight := RangeFind.Borders[1].Weight;
Range.Borders[2].Weight := RangeFind.Borders[2].Weight;
Range.Borders[3].Weight := RangeFind.Borders[3].Weight;
Range.Borders[4].Weight := RangeFind.Borders[4].Weight;
end else
begin
Range.Characters.Font.Name := FontNameData;
Range.Characters.Font.Size := FontSizeData;
Range.Borders[1].Weight := 2;
Range.Borders[2].Weight := 2;
Range.Borders[3].Weight := 2;
Range.Borders[4].Weight := 2;
end;
Range := Sheet.Range[RowColToStr(RowIndex, 1, RowEnd, ColSum)];
Range.Select;
if (FileName <> '') and RepString('%数据%', '') then
begin
Range.Characters.Font.Name := RangeFind.Characters.Font.Name;
Range.Characters.Font.Size := RangeFind.Characters.Font.Size;
Range.HorizontalAlignment := RangeFind.HorizontalAlignment;
Range.Characters.Font.FontStyle := RangeFind.Characters.Font.FontStyle;
Range.Borders[1].Weight := RangeFind.Borders[1].Weight;
Range.Borders[2].Weight := RangeFind.Borders[2].Weight;
Range.Borders[3].Weight := RangeFind.Borders[3].Weight;
Range.Borders[4].Weight := RangeFind.Borders[4].Weight;
end else
begin
Range.Characters.Font.Name := FontNameData;
Range.Characters.Font.Size := FontSizeData;
Range.Borders[1].Weight := 2;
Range.Borders[2].Weight := 2;
Range.Borders[3].Weight := 2;
Range.Borders[4].Weight := 2;
end;
//设置数字栏显示格式
if FileName = '' then
SetFormat();
if FileName = '' then
SetFormat();
//加载数据到Excel
lb.Caption := '正在导出数据......';
Form.Update();
DoDataSetToExcel();
lb.Caption := '正在导出数据......';
Form.Update();
DoDataSetToExcel();
Sheet.Range['A1:A1'].Select;
if FileName = '' then
begin
Sheet.PageSetup.LeftMargin := Excel.InchesToPoints(0.590551181102362);//Excel.InchesToPoints(0.393700787401575);
Sheet.PageSetup.RightMargin := Sheet.PageSetup.LeftMargin;
Sheet.PageSetup.TopMargin := Sheet.PageSetup.LeftMargin;
Sheet.PageSetup.BottomMargin := Sheet.PageSetup.LeftMargin;
Sheet.PageSetup.CenterHorizontally := True;
Sheet.PageSetup.CenterVertically := True;
Sheet.PageSetup.CenterFooter := '第 &P 页，共 &N 页';
end;
CheckPageWidth();
begin
Sheet.PageSetup.LeftMargin := Excel.InchesToPoints(0.590551181102362);//Excel.InchesToPoints(0.393700787401575);
Sheet.PageSetup.RightMargin := Sheet.PageSetup.LeftMargin;
Sheet.PageSetup.TopMargin := Sheet.PageSetup.LeftMargin;
Sheet.PageSetup.BottomMargin := Sheet.PageSetup.LeftMargin;
Sheet.PageSetup.CenterHorizontally := True;
Sheet.PageSetup.CenterVertically := True;
Sheet.PageSetup.CenterFooter := '第 &P 页，共 &N 页';
end;
CheckPageWidth();
case Flag of
1: //打印预览
begin
Excel.Visible := True;
Form.Hide();
Workbook.Saved := True;
Excel.DisplayAlerts := False;
Sheet.PrintPreview;
Excel.Visible := False;
Excel.Quit;
end;
2: //直接打印
begin
Form.Hide();
Sheet.PrintOut;
Workbook.Saved := True;
Excel.DisplayAlerts := False;
Excel.Quit;
end;
else //打开Excel编辑
Form.Hide();
Excel.Visible := True;
end;
except
Workbook.Saved := True;
Excel.DisplayAlerts := False;
Excel.Quit;
end;
finally
Excel := UnAssigned;
end;
end;
finally
lb.Destroy();
Form.Destroy();
Screen.Cursor := CursorSave;
end;
end;
1: //打印预览
begin
Excel.Visible := True;
Form.Hide();
Workbook.Saved := True;
Excel.DisplayAlerts := False;
Sheet.PrintPreview;
Excel.Visible := False;
Excel.Quit;
end;
2: //直接打印
begin
Form.Hide();
Sheet.PrintOut;
Workbook.Saved := True;
Excel.DisplayAlerts := False;
Excel.Quit;
end;
else //打开Excel编辑
Form.Hide();
Excel.Visible := True;
end;
except
Workbook.Saved := True;
Excel.DisplayAlerts := False;
Excel.Quit;
end;
finally
Excel := UnAssigned;
end;
end;
finally
lb.Destroy();
Form.Destroy();
Screen.Cursor := CursorSave;
end;
end;
end.
赞 (0)