1.TDataSet-->xls
procedure ExportXls(dts:TDataSet);
var
varFieldValue:Variant;
xls:variant;
i,j:integer;
mark:TBookMark;
begin
if (dts.FieldCount=0) and (dts.IsEmpty) then
showmessage('无数据可导出!')
else
try //except
xls:=CreateOleObject('excel.application');
xls.workbooks.add;
varFieldValue:=VarArrayCreate([0,dts.FieldCount-1],varVariant);
try //finally
mark:=dts.GetBookmark ;
dts.DisableControls ;
For j:=0 to dts.FieldCount-1do
begin
xls.cells(1,j+1):= dts.Fields[j].FieldName;
end;
dts.First ;
For i:=1 to dts.RecordCountdo
begin
For j:=0 to dts.FieldCount-1do
begin
varFieldValue[j]:=dts.Fields[j].Value;
case varType(varFieldValue[j]) of
varEmpty:varFieldValue[j]:='';
varNull:varFieldValue[j]:='';
varSmallint:varFieldValue[j]:=dts.Fields[j].AsInteger;
varInteger:varFieldValue[j]:=dts.Fields[j].AsInteger;
varSingle:varFieldValue[j]:=dts.Fields[j].AsFloat;
varDouble:varFieldValue[j]:=dts.Fields[j].AsFloat;
varCurrency:varFieldValue[j]:=dts.Fields[j].AsFloat;
varDate: varFieldValue[j]:=dts.Fields[j].AsDateTime;
varOleStr:varFieldValue[j]:=dts.Fields[j].AsString;
varDispatch:varFieldValue[j]:='';
varError:varFieldValue[j]:='';
varBoolean:if dts.Fields[j].AsBoolean then
varFieldValue[j]:='是' else
varFieldValue[j]:='否';
varVariant:varFieldValue[j]:='';
varUnknown:varFieldValue[j]:='';
varByte:varFieldValue[j]:='';
varString:varFieldValue[j]:=dts.Fields[j].AsString;
varTypeMask:varFieldValue[j]:='';
varArray: varFieldValue[j]:='';
varByRef: varFieldValue[j]:='';
varWord: varFieldValue[j]:=dts.Fields[j].AsInteger;
varLongWord: varFieldValue[j]:=dts.Fields[j].AsInteger;
varInt64:varFieldValue[j]:=dts.Fields[j].AsInteger;
varAny: varFieldValue[j]:='';
varStrArg: varFieldValue[j]:='';
varShortInt: varFieldValue[j]:=dts.Fields[j].AsInteger;
else
//case
varFieldValue[j]:='';
end;
//case
xls.cells(i+1,j+1):= varFieldValue[j];
end;
//for j
dts.Next ;
end;
//for i
dts.GotoBookmark(mark);
dts.EnableControls ;
xls.visible:=true;
finally //try finally
dts.FreeBookmark(mark);
end;
//try finally
except //try Except
if dts.ControlsDisabled then
dts.EnableControls ;
if not VarIsEmpty(xls) then
//测试Excel是否存在
begin
xls.displayAlerts:=false;
//退出时不提示保存
xls.quit;
//退出Excel
xls:=unassigned;
//xls.displayAlerts:=false;让对象不可见
end;
showmessage('导出数据时出现错误,可能原因:没有正确安装Excel;系统所使用的报表文件已打开,正在使用中!');
end;
//try Except
end;
2.GridEH-->XLS:
var
dlgExport:TSaveDialog;
xls:variant;
......
//njch 20050420 Ctrl_E ExportData
if (shift=[ssCtrl]) and (key=word('E')) then
begin
dlgExport:=TSaveDialog.Create(Self);
dlgExport.Filter:='Excel(*.xls)|*.xls|文本文件(*.txt)|*.txt|CSV格式文件(*.csv)|*.csv|RTF格式文件(*.rtf)|*.rtf|超文本格式文件(*.htm)|*.htm|VCL格式文件(*.vcl)|*.vcl';
dlgExport.Options := [ofOverwritePrompt,ofEnableSizing];
dlgExport.FileName:=DateToStr(Date);
case dlgExport.FilterIndex of //设置黓认扩展名
1:dlgExport.DefaultExt:='xls';
2:dlgExport.DefaultExt:='txt';
3:dlgExport.DefaultExt:='csv';
4:dlgExport.DefaultExt:='rtf';
5:dlgExport.DefaultExt:='htm';
6:dlgExport.DefaultExt:='vcl';
end;
if not dlgExport.Execute then
begin
FreeAndNil(dlgExport);
Exit;
end;
case dlgExport.FilterIndex of
1: SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,FSelection.FGrid,dlgExport.FileName,False);
2: SaveDBGridEhToExportFile(TDBGridEhExportAsTEXT,FSelection.FGrid,dlgExport.FileName,False);
3: SaveDBGridEhToExportFile(TDBGridEhExportAsCSV,FSelection.FGrid,dlgExport.FileName,False);
4: SaveDBGridEhToExportFile(TDBGridEhExportAsRTF,FSelection.FGrid,dlgExport.FileName,False);
5: SaveDBGridEhToExportFile(TDBGridEhExportAsHTML,FSelection.FGrid,dlgExport.FileName,False);
6: SaveDBGridEhToExportFile(TDBGridEhExportAsVCLDBIF,FSelection.FGrid,dlgExport.FileName,False);
end;
if dlgExport.FilterIndex=1 then
//自动打开xls
begin
try
xls:=CreateOleObject('excel.application');
xls.WorkBooks.Open(dlgExport.FileName);
xls.Visible := True;
except
if not VarIsEmpty(xls) then
//测试Excel是否存在
begin
xls.quit;
//退出Excel
xls:=unassigned;
end;
end;
end;
FreeAndNil(dlgExport);
end;
//if ctrl_E