DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: webb123
今日帖子: 33
在线用户: 17
导航: 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者:
男 wujer (wujer) ★☆☆☆☆ -
普通会员
2003/6/19 10:10:35
标题:
怎么把数据导入Execl里面,我用ADOQuery!!! 浏览:3840
加入我的收藏
楼主: 哪位高手给指点指点,贴出简单一些的方法,或提供控件也行,谢了!!!
----------------------------------------------
wujer
作者:
女 123 (猪猪) ★☆☆☆☆ -
盒子活跃会员
2003/6/19 10:39:00
1楼: 精华区看看去。
----------------------------------------------
-
作者:
男 supermay (supermay) ★☆☆☆☆ -
盒子活跃会员
2003/6/19 12:07:03
2楼: 我自编写了一个控件你要吗?
----------------------------------------------
链接:https://pan.baidu.com/s/12jzmECYKhGCsHBxz8tmB6w 提取码:pelr --来自百度网盘超级会员V9的分享
作者:
男 looper (keyo) ★☆☆☆☆ -
盒子活跃会员
2003/6/19 17:55:37
3楼: DBGridToExcel:

procedure DBGrid2Excel(DBGrid:TDBGrid;ExcelFileName:string);
var  MyExcel: Variant;
     x,y:integer;
begin
  deletefile(ExcelFileName);
  MyExcel := CreateOleOBject('Excel.Application');
  MyExcel.WorkBooks.Add;
  MyExcel.Visible := True;
  MyExcel.WorkBooks[1].Saveas(ExcelFileName);
  dbgrid.DataSource.DataSet.First;

  y:=1;
  for x:=1 to dbgrid.FieldCount do
  begin
    MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,x] := dbgrid.Fields[x-1].DisplayName;

    MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,x].Select;

    MyExcel.Selection.Font.Bold := true;

    MyExcel.WorkBooks[1].WorkSheets[1].Columns[x].ColumnWidth := dbgrid.Fields[x-1].DisplayWidth;
  end;
  inc(y);
  while not dbgrid.DataSource.DataSet.eof do
  begin
    for x:=1 to dbgrid.FieldCount do
    begin
       MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,x] := dbgrid.Fields[x-1].AsString;
    end;
    inc(y);
    dbgrid.DataSource.DataSet.next;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   DBGrid2Excel(dbgrid1,edit1.text);
end;
procedure TForm1.LabelDelphiKTopClick(Sender: TObject);
begin
   ShellExecute(application.handle,pchar('OPEN'),pchar('http://www.chetel.com.cn'),nil,nil,0);
end;
----------------------------------------------
虽千万人吾往矣!
作者:
男 looper (keyo) ★☆☆☆☆ -
盒子活跃会员
2003/6/19 17:58:50
4楼: //DatasetToExcel

//==============================================
unit XLSFile;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, 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);

implementation

procedure 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].FieldName);
    r:=1;
    ds.first;
    while not ds.eof do begin
      for c:=0 to ds.FieldCount-1 do
        xls.WriteField(r,c,ds.Fields[c]);
      inc(r);
      ds.next;
    end;
    if r > xls.maxrows then begin
      xls.fstream.Seek(10,soFromBeginning);
      xls.WriteDimension;
    end;
    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;
  maxRows:=1000;
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;

     {Byte Offset     Bit   Description                     Contents
     0          7     Cell is not hidden              0b
                      Cell is hidden                  1b
                6     Cell is not locked              0b
                      Cell is locked                  1b
                5-0   Reserved, must be 0             000000b
     1          7-6   Font number (4 possible)
                5-0   Cell format code
     2          7     Cell is not shaded              0b
                      Cell is shaded                  1b
                6     Cell has no bottom border       0b
                      Cell has a bottom border        1b
                5     Cell has no top border          0b
                      Cell has a top border           1b
                4     Cell has no right border        0b
                      Cell has a right border         1b
                3     Cell has no left border         0b
                      Cell has a left border          1b
                2-0   Cell alignment code
                           general                    000b
                           left                       001b
                           center                     010b
                           right                      011b
                           fill                       100b
                           Multiplan default align.   111b
     }

     //  bit sequence 76543210

     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;
     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);
var  FAtribut:array [0..2] of byte;
begin
  case field.DataType of
     ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
       Cellstr(vcol,vrow,field.asstring);
     ftSmallint,ftInteger,ftWord:
       CellWord(vcol,vRow,field.AsInteger);
     ftFloat, ftBCD:
       CellDouble(vcol,vrow,field.AsFloat);
  end;
end;

//=====================================================================
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBTables, Grids, DBGrids,xlsfile;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    Table1: TTable;
    DataSource1: TDataSource;
    Button1: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
   if SaveDialog1.Execute then
    DataSetToXLS(dbgrid1.DataSource.dataset,SaveDialog1.filename);
end;

end.

----------------------------------------------
虽千万人吾往矣!
作者:
男 babyluoyi (赵子龙) ★☆☆☆☆ -
盒子活跃会员
2003/6/20 18:13:07
5楼: 真够多的!眼花瞭乱!!
----------------------------------------------
好好学习,天天向上!
作者:
男 30896186 (缘来一家人) ★☆☆☆☆ -
盒子活跃会员
2003/6/26 10:46:46
6楼: 用dxdbgrid控件吧
只要一条语名
savetoxls();就可以了
----------------------------------------------
-
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行46.875毫秒 RSS