procedure TForm1.Button1Click(Sender: TObject); var str:String; strlist:TStringList; i:Integer; begin DeleteFile('zg.xls'); strlist:=TStringList.Create; ADOTable1.First; for i:=0 to ADOTable1.FieldCount-1 do str:=str+ADOTable1.Fields[i].FieldName+#9;
strlist.Add(str);
try while not ADOTable1.Eof do begin str:=''; for i:=0 to ADOTable1.FieldCount-1 do str:=Str+ADOTable1.Fields[i].AsString+#9; strlist.Add(str); ADOTable1.Next; Application.ProcessMessages; end; strlist.SaveToFile('zg.xls'); ShowMessage('OK'); finally strlist.Free; end; end;
procedure TForm1.Button1Click(Sender: TObject); var strlist:tstringlist; str:string; i:integer; path:string; begin savedialog1.DefaultExt:='xls'; savedialog1.Filter:=combobox2.Text; if savedialog1.Execute then path:=savedialog1.FileName; if path='' then abort; strlist:=tstringlist.Create; with adoquery1 do begin close; sql.Clear; sql.Add('select * from xs'); execsql; open end; progressbar1.Max:=adoquery1.RecordCount; progressbar1.Position:=0; while not adoquery1.Eof do begin str:=''; for i:=0 to adoquery1.FieldCount-1 do str:=str+adoquery1.Fields[i].AsString+#9; strlist.Add(str); progressbar1.StepBy(1); adoquery1.Next; end; strlist.SaveToFile(path); showmessage('done'); strlist.Free;end;这是我写的,xls,doc,wps随便导 呵呵,
--------------------------------------------------------------\
unit WriteData;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGridEh, DB, ADODB, StdCtrls, Buttons, XPMenu, DBGrids;//目标是: 通过普通AdoQuery来导出数据!
//Create by yxf
//Date: 2004-10-05
// type TColumnsList = class(TList)
private
function GetColumn(Index: Integer): TColumn;
procedure SetColumn(Index: Integer; const Value: TColumn);
public
property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
end; TColCellParams = class
protected
FAlignment: TAlignment;
FBackground: TColor;
FCol: Longint;
FFont: TFont;
FImageIndex: Integer;
FReadOnly: Boolean;
FRow: Longint;
FState: TGridDrawState;
FText: String;
public
property Alignment: TAlignment read FAlignment write FAlignment;
property Background: TColor read FBackground write FBackground;
property Col: Longint read FCol;
property Font: TFont read FFont;
property ImageIndex: Integer read FImageIndex write FImageIndex;
property ReadOnly: Boolean read FReadOnly write FReadOnly;
property Row: Longint read FRow;
property State: TGridDrawState read FState;
property Text: String read FText write FText;
end; TWriteData = class
private
//FColCellParamsEh: TColCellParamsEh;
FDBGrid: TCustomDBGrid;
FQry: TAdoQuery;
//FExpCols: TColumnsEhList;
FStream: TStream;
//function GetFooterValue(Row, Col: Integer): String;
//procedure CalcFooterValues;
FCol, FRow: Word;
FSummary: TStringList;
// FColumns: TColumnsList;
// FCount: integer;//列总和 protected
// FooterValues: PFooterValues;
procedure WriteBlankCell;
procedure WriteEnter;
procedure WriteIntegerCell(const AValue: Integer);
procedure WriteFloatCell(const AValue: Double);
procedure WriteStringCell(const AValue: String);
procedure IncColRow;
procedure WritePrefix;
procedure WriteSuffix;
procedure WriteTitle;
procedure WriteRecord(ColumnsList: TColumnsList);
procedure WriteDataCell(Column: TColumn; FColCellParams: TColCellParams);
//procedure WriteFooter(ColumnsList: TColumnsEhList; FooterNo: Integer);
//procedure WriteFooterCell(DataCol, Row: Integer; Column: TColumnEh; AFont: TFont;
// Background: TColor; Alignment: TAlignment; Text: String);
property Stream: TStream read FStream write FStream;
//property ExpCols: TColumnsEhList read FExpCols write FExpCols;
public
constructor Create;
destructor Destroy; override;
procedure ExportToStream(AStream: TStream; IsExportAll: Boolean);
procedure ExportToFile(FileName: String; IsExportAll: Boolean);
property Summary: TStringList read FSummary write FSummary;
property Qry: TAdoQuery read FQry write FQry;
property DBGrid: TCustomDBGrid read FDBGrid write FDBGrid;
end;
implementation{ TWriteData }var
CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
CXlsEof: array[0..1] of Word = ($0A, 00);
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);constructor TWriteData.Create;
begin
// FDBGrid := TCustomDBGrid.Create(self);
FSummary := TStringList.Create ;
inherited;
end;destructor TWriteData.Destroy;
begin
FSummary.Free ;
inherited;
end;procedure TWriteData.ExportToFile(FileName: String; IsExportAll: Boolean);
var FileStream: TFileStream;
begin
FileStream := TFileStream.Create(FileName, fmCreate);
try
ExportToStream(FileStream, IsExportAll);
finally
FileStream.Free;
end;
end;procedure TWriteData.ExportToStream(AStream: TStream;
IsExportAll: Boolean);
var
// ColList: TColumnsEhList;
BookMark: Pointer;
i: Integer;
begin FCol := 0;
FRow := 0; Stream := AStream; WritePrefix;
//写标题 WriteTitle;
BookMark := Qry.GetBook; Qry.DisableControls ;
Screen.Cursor := crSQLWait;
try
if not Qry.Active then Qry.Open ;
Qry.First ;
While not Qry.Eof do
begin
for I := 0 to Qry.FieldCount - 1 do
begin
case Qry.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(Qry.Fields[i].AsInteger );
ftFloat, ftCurrency, ftBCD{$IFDEF EH_LIB_6}, ftFMTBcd{$ENDIF}:
WriteFloatCell(Qry.Fields[i].AsFloat);
else
WriteStringCell(Qry.Fields[i].AsString );
end;
end;
Qry.Next ;
end;
finally
Qry.GotoBook(BookMark);
Qry.EnableControls ;
Qry.FreeBook(BookMark);
WriteEnter;
WriteStringCell('查询条件:');
WriteEnter;
for I:= 0 to FSummary.Count - 1 do
begin
if FSummary.Strings[I] = '#13' then WriteEnter else
WriteStringCell(FSummary.Strings[I]);
WriteEnter;
end;
Screen.Cursor := crdefault;
end;
WriteSuffix;
ShowMessage('数据导入成功完成!');
//具体处理导出设置
end;----------------------------------------------------------
其实不用控件也不需要这么烦
var
I: Integer;
Str: String;
StrList: TStringList;//用于存储数据的字符列表
begin
StrList := TStringList.Create;
try
with Table1 do
begin
First;
while not Eof do
begin
Str := '';
for I := 0 to FieldCount-1 do
Str := Str + Fields[I].AsString + #9;
StrList.Add(Str);
Next;
end;
StrList.SaveToFile('test.xls');
end;
StrList.Free;
except
StrList.Free;
end;
end;-----------------------------------------------把DBGrid导出到Excel表格(支持多Sheet) {
功能描述:把DBGrid输出到Excel表格(支持多Sheet)
调用格式:CopyDbDataToExcel([DBGrid1, DBGrid2]);
}
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end; try
XLApp := CreateOleObject(‘Excel.Application‘);
except
Screen.Cursor := crDefault;
Exit;
end; XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1; for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name]; if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end; TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption; jCount := 1;
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString; Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
XlApp.Visible := True;
end;
Screen.Cursor := crDefault;
end;
如果是简单的导出很简单的
我给你一个d语言的procedure CopyDbDataToExcel(Target: TDbgrid;sheetname:string;filename:string);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add[filename]; //你要把数据放在那里
XLApp.WorkBooks[1].WorkSheets[1].Name := sheetname;
Sheet := XLApp.Workbooks[1].WorkSheets[XLApp.WorkBooks[1].WorkSheets[1].Name];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first;
//ExcelWorkSheet1.Cells.NumberFormat :='@'for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
end;
jCount := 1;
while not Target.DataSource.DataSet.Eof do
begin
for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
我程序里的一段
procedure CopyDbDataToExcel(Target: TDbgrid;sheetname:string;filename:string);
这些是传入函数
特别 是 Open2ye 大哥和 advancejar
您好!
假设我单击 button2 就 需要 把 dbgrid1 里的数据 放到 表名为 myexcel 的excel 表中保存路径 为 C:\Documents and Settings\Administrator\My Documents\excel
那么调用是这样的吗?procedure TForm1.Button2Click(Sender: TObject);
begin
CopyDbDataToExcel(dbgrid1,'myexcel','C:\Documents and Settings\Administrator\My Documents\excel');
end;
可是我单击 Button2
出现了这样的错误:不能访问只读文件 excel !advancejar 大哥 ,我那里做错误了呢?
祝 advancejar 大哥 和各位大哥 端午节快乐!
var
str:String;
strlist:TStringList;
i:Integer;
begin
DeleteFile('zg.xls');
strlist:=TStringList.Create;
ADOTable1.First;
for i:=0 to ADOTable1.FieldCount-1 do
str:=str+ADOTable1.Fields[i].FieldName+#9;
strlist.Add(str);
try
while not ADOTable1.Eof do
begin
str:='';
for i:=0 to ADOTable1.FieldCount-1 do
str:=Str+ADOTable1.Fields[i].AsString+#9;
strlist.Add(str);
ADOTable1.Next;
Application.ProcessMessages;
end;
strlist.SaveToFile('zg.xls');
ShowMessage('OK');
finally
strlist.Free;
end;
end;
您好!
'zg.xls'的具体路径是什么啊?谢谢!
做一个UNIT 然后使用
代码如下:
unit UnitXLSFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms,
Dialogs,db,dbctrls,comctrls;
const
{BOF}
CBOF = $0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000a;
{Document types}
DOCTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;
type
TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);
TSetOfAtribut = set of TatributCell;
TXLSWriter = class(Tobject)
private
fstream:TFileStream;
procedure WriteWord(w:word);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
maxCols,maxRows:Word;
procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
procedure WriteField(vCol,vRow:word;Field:TField);
constructor create(vFileName:string);
destructor destroy;override;
end;procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
procedure DataSetToXLS(ds:TDataSet;fname:String);
procedure StringGridToXLS(grid:TStringGrid;fname:String);implementationprocedure DataSetToXLS(ds:TDataSet;fname:String);
var c,r:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
if ds.FieldCount > xls.maxcols then
xls.maxcols:=ds.fieldcount+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to ds.FieldCount-1 do
xls.Cellstr(0,c,ds.Fields[c].DisplayLabel);
r:=1;
ds.first;
while (not ds.eof) and (r <= xls.maxrows) do begin
for c:=0 to ds.FieldCount-1 do
if ds.Fields[c].AsString<>'' then
xls.WriteField(r,c,ds.Fields[c]);
inc(r);
ds.next;
end;
xls.writeEOF;
finally
xls.free;
end;
end;procedure StringGridToXLS(grid:TStringGrid;fname:String);
var c,r,rMax:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
rMax:=grid.RowCount;
if grid.ColCount > xls.maxcols then
xls.maxcols:=grid.ColCount+1;
if rMax > xls.maxrows then // ¦¹®æ¦¡³Ì¦h¥u¯à¦s 65535 Rows
rMax:=xls.maxrows;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to grid.ColCount-1 do
for r:=0 to rMax-1 do
xls.Cellstr(r,c,grid.Cells[c,r]);
xls.writeEOF;
finally
xls.free;
end;
end;{ TXLSWriter }constructor TXLSWriter.create(vFileName:string);
begin
inherited create;
if FileExists(vFilename) then
fStream:=TFileStream.Create(vFilename,fmOpenWrite)
else
fStream:=TFileStream.Create(vFilename,fmCreate); maxCols:=100; // <2002-11-17> dllee Column À³¸Ó¬O¤£¥i¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
maxRows:=65535; // <2002-11-17> dllee ³o­Ó®æ¦¡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´N¤j©ó³o­Ó­È
end;destructor TXLSWriter.destroy;
begin
if fStream <> nil then
fStream.free;
inherited;
end;procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6); // count of bytes
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS); // dimension OP Code
Writeword(8); // count of bytes
Writeword(0); // min cols
Writeword(maxRows); // max rows
Writeword(0); // min rowss
Writeword(maxcols); // max cols
end;procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
vAtribut: TSetOfAtribut);
var FAtribut:array [0..2] of byte;
begin
Writeword(3); // opcode for double
Writeword(15); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(aValue,8);
end;procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
var FAtribut:array [0..2] of byte;
begin
Writeword(2); // opcode for word
Writeword(9); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
Writeword(aValue);
end;procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: String;
vAtribut: TSetOfAtribut);
var FAtribut:array [0..2] of byte;
slen:byte;
begin
Writeword(4); // opcode for string
slen:=length(avalue);
Writeword(slen+8); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(slen,1);
fStream.Write(aValue[1],slen);
end;procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
i:integer;
begin
//reset
for i:=0 to High(FAtribut) do
FAtribut[i]:=0;
if acHidden in value then //byte 0 bit 7:
FAtribut[0] := FAtribut[0] + 128; if acLocked in value then //byte 0 bit 6:
FAtribut[0] := FAtribut[0] + 64 ; if acShaded in value then //byte 2 bit 7:
FAtribut[2] := FAtribut[2] + 128; if acBottomBorder in value then //byte 2 bit 6
FAtribut[2] := FAtribut[2] + 64 ; if acTopBorder in value then //byte 2 bit 5
FAtribut[2] := FAtribut[2] + 32; if acRightBorder in value then //byte 2 bit 4
FAtribut[2] := FAtribut[2] + 16; if acLeftBorder in value then //byte 2 bit 3
FAtribut[2] := FAtribut[2] + 8; if acLeft in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 1
else if acCenter in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 2
else if acRight in value then //byte 2, bit 0 dan bit 1
FAtribut[2] := FAtribut[2] + 3
else if acFill in value then //byte 2, bit 0
FAtribut[2] := FAtribut[2] + 4;
end;procedure TXLSWriter.WriteWord(w: word);
begin
fstream.Write(w,2);
end;procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
begin
case field.DataType of
ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
Cellstr(vcol,vrow,field.asstring);
ftAutoInc,ftSmallint,ftInteger,ftWord:
CellWord(vcol,vRow,field.AsInteger);
ftFloat, ftBCD:
CellDouble(vcol,vrow,field.AsFloat);
else
Cellstr(vcol,vrow,EmptyStr);
end;
end;
end.
您好! if rMax > xls.maxrows then // ¦¹®æ¦¡³Ì¦h¥u¯à¦s 65535 这里是怎么写的,我复制到我的程序里,编译时有错,& 是什么意思啊? // 是在注释 ¦¹®æ¦¡³Ì¦h¥u¯à¦s 65535 这一行的吗?还有是,当我单击 button1 ,就要把数据 倒入到 excel ,请教 fhuibo 大哥,我在 Button1Click 事件里需要写哪些东西呢?
谢谢!
rMax:=xls.maxrows;那个 Rows 有没有用的啊?谢谢!
您好!
'zg.xls'的具体路径是什么啊?谢谢!
==========================================='zg.xls'其实他的路径默认就是和你这个应用程序在同一个目录下。
你也可以写成:strlist.SaveToFile(ExtractFilePath(Application.ExeName)+'zg.xls')
var strlist:tstringlist;
str:string;
i:integer;
path:string;
begin
savedialog1.DefaultExt:='xls';
savedialog1.Filter:=combobox2.Text;
if savedialog1.Execute then
path:=savedialog1.FileName;
if path='' then abort;
strlist:=tstringlist.Create;
with adoquery1 do
begin
close;
sql.Clear;
sql.Add('select * from xs');
execsql;
open
end;
progressbar1.Max:=adoquery1.RecordCount;
progressbar1.Position:=0;
while not adoquery1.Eof do
begin
str:='';
for i:=0 to adoquery1.FieldCount-1 do
str:=str+adoquery1.Fields[i].AsString+#9;
strlist.Add(str);
progressbar1.StepBy(1);
adoquery1.Next;
end;
strlist.SaveToFile(path);
showmessage('done');
strlist.Free;end;这是我写的,xls,doc,wps随便导
呵呵,