如何用DBGridEH 导出excel来??? ( 积分: 50 )

  • 主题发起人 主题发起人 joe818
  • 开始时间 开始时间
J

joe818

Unregistered / Unconfirmed
GUEST, unregistred user!
本人刚接触delphi,用的是delphi7版本,现在遇到如何用DBGridEH 把内容导出到Excel2000里,很多网站虽然贴出有关的方法,但是很多代码好象不能直接编译的呀!!!可是我是菜鸟呀,怎么办呀?哪位大侠帮帮吧!在此感谢各大哥了。
 
本人刚接触delphi,用的是delphi7版本,现在遇到如何用DBGridEH 把内容导出到Excel2000里,很多网站虽然贴出有关的方法,但是很多代码好象不能直接编译的呀!!!可是我是菜鸟呀,怎么办呀?哪位大侠帮帮吧!在此感谢各大哥了。
 
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
 
Uses
DBGridEhImpExp;
SaveDBGridEhToExportFile(TDBGridEhExportAsXLS, DBGridEh1, FileName, True);
 
用控件,很好用。word excel, 只要几句code
http://www.scalabium.com/sme.htm
 
uses DBGridEhImpExp;
procedure TBaseQuery.N6Click(Sender: TObject);
var ExpClass: TDBGridEhExportClass;
Ext: string;
SaveD: TSaveDialog;
begin
if not DBGridEh.datasource.dataset.Active then
begin
MessageDialog(StrErrorSign,'请先查询资料!', mterror, [Mbok], 0, 0);
Exit;
end;
SaveD := TSaveDialog.Create(nil);
SaveD.Options :=[ofOverwritePrompt,ofHideReadOnly,ofEnableSizing];
SaveD.Title := '数据导出--请选择保存位置...' ;
SaveD.InitialDir := GStrWorkdir;
SaveD.Filter := 'Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HT' +
'ML file (*.htm)|*.HTM|Rich Text Format (*.rtf)|*.RTF|Microsoft E' +
'xcel Workbook (*.xls)|*.XLS';
SaveD.FileName := 'file1';
if SaveD.Execute then
begin
case SaveD.FilterIndex of
1: begin
ExpClass := TDBGridEhExportAsText;
Ext := 'txt';
end;
2: begin
ExpClass := TDBGridEhExportAsCSV;
Ext := 'csv';
end;
3: begin
ExpClass := TDBGridEhExportAsHTML;
Ext := 'htm';
end;
4: begin
ExpClass := TDBGridEhExportAsRTF;
Ext := 'rtf';
end;
5: begin
ExpClass := TDBGridEhExportAsXLS;
Ext := 'xls';
end;
else
ExpClass := nil;
Ext := '';
end;
if ExpClass <> nil then
begin
if UpperCase(Copy(SaveD.FileName, Length(SaveD.FileName) - 2, 3)) <>
UpperCase(Ext) then
SaveD.FileName := SaveD.FileName + '.' + Ext;
SaveDBGridEhToExportFile(ExpClass, DBGridEh , SaveD.FileName, False);
end;
end;
DBGridEh.Selection.Clear;
end;
 
谢谢各位了
 
请问方竹,您能留下个QQ号吗?我的QQ为48235843,能交个朋友吗?方便吗?
 
TDBGridEhExportClass是什么类的?
我怎么不可以使用
到底是什么原因?
 
后退
顶部