procedure ExportToExcel(SDBGrid:TDBGrid;ExcelCaption:String;SheetsName:string;
TheTitle:string;TitleSize:Integer;FontBold:Boolean;PrintViewTitle:string);
var
iCount, jCount: Integer;
XLApp: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
if not SDBGrid.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end else begin
try
XLApp := CreateOleObject('Excel.Application');
except
Application.MessageBox(PChar('Excel 無法打開,請檢查您是否安裝了Excel軟體。'),PChar('提示'),MB_OK+MB_ICONERROR) ;
Screen.Cursor := crDefault;
Exit;
end;
end;
XLApp.WorkBooks.Add; //新加工作薄
XLApp.Caption:=ExcelCaption; //工作薄名
//显示标题
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+'2',GetExcelCoulmnCaption(I+1)+'2'];
Range.RowHeight:=24;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Font.FontStyle:='加粗';
Range.Columns.AutoFit;
Range.Value:=DataSet.Fields[I].FieldName;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
//显示内容
//set
Range:=V.Range['A3',GetExcelCoulmnCaption(DataSet.FieldCount)+IntToStr(DataSet.recordcount+2)];
Range.NumberFormatLocal:= '@';
Range.RowHeight:=20;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Columns.AutoFit;
PB.TotalParts:=DataSet.RecordCount;
DataSet.First;
While (Not DataSet.Eof) do
begin
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2),GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2)];
if DataSet.Fields[I].IsNull then
Range.Value:=' '
else
Range.Value:=DataSet.Fields[I].AsString;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
PB.IncPartsByOne;
DataSet.next;
end;
procedure TPrintSQL_Data.SetActive(Value: Boolean);
begin
If Value then
begin
If DataSet.Connection<>nil then
begin
try
With DataSet do
begin
IF Active then Active:=false;
Commandtext:=FSQLString;
Active:=true;
FActive:=Value;
end;
except
on E:Exception do
MessageDlg('查询操作失败!'+#13#10+'异常类:'+E.ClassName+#13#10+'错误信息代码为:'+E.Message,mtinformation,[MBOK],0);
end;
end
else MessageDlg('没有选择数据库连接对象!',mtinformation,[MBOK],0);
end else begin
FActive:=Value;
Fprinting:=False;
end;
end;
procedure TPrintSQL_Data.SetDataSet(Value: TADODataSet);
begin
FDataSet:=Value;
end;
procedure TPrintSQL_Data.SetExcelFileName(Value: string);
begin
FExcelFileName:=Value;
end;
procedure TPrintSQL_Data.SetExcelTitle(Value: TCaption);
begin
FExcelTitle:=value;
end;
procedure TPrintSQL_Data.SetPrinting(Value: boolean);
begin
if Active then
begin
if self.DataSet.Fields.Count>0 then
if Value then
PrintSqlDataToExcel;
end else FPrinting := Value;
end;
procedure TPrintSQL_Data.SetSQLString(Value: string);
begin
FSQLString:=Value;
FActive:=false;
FPrinting:=False;
end;
procedure Register;
begin
RegisterComponents('rocxu', [TPrintSQL_Data]);
end;
{ TPrintSQL_Data }
constructor TPrintSQL_Data.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TPrintSQL_Data.Destroy;
begin
inherited;
end;
function TPrintSQL_Data.GetExcelCoulmnCaption(num: Cardinal): string;
var
mod_num,div_num:Cardinal;
begin
if num=0 then exit;
if (num mod 26=0) then mod_num:=26
else mod_num:=num mod 26;
div_num:=num div 26;
if mod_num=26 then DEC(div_num);
if div_num=0 then
Result:=Chr(64+mod_num)
else Result:=Chr(64+div_num)+Chr(64+mod_num);
end;
procedure TPrintSQL_Data.PrintSqlDataToExcel;
var
I:integer;
Range,ExcelApp,V:variant;
begin
Try
ExcelApp:=CreateOleObject('Excel.application');
Except
MessageDlg('没有安装Office 办公软件Excel!',mtinformation,[MBOK],0);
exit;
End;
//显示标题
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+'2',GetExcelCoulmnCaption(I+1)+'2'];
Range.RowHeight:=24;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Font.FontStyle:='加粗';
Range.Columns.AutoFit;
Range.Value:=DataSet.Fields[I].FieldName;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
//显示内容
//set
Range:=V.Range['A3',GetExcelCoulmnCaption(DataSet.FieldCount)+IntToStr(DataSet.recordcount+2)];
Range.NumberFormatLocal:= '@';
Range.RowHeight:=20;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Columns.AutoFit;
DataSet.First;
While (Not DataSet.Eof) do
begin
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2),GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2)];
if DataSet.Fields[I].IsNull then
Range.Value:=' '
else
Range.Value:=DataSet.Fields[I].AsString;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
DataSet.next;
end;