unit1.pas

此程序是可以将数据库表中的数据导出转为EXCEL、也可将EXCEL中的数据导入至数据库的表中。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,AdoConED, ExcelXP, OleServer, DBTables, DB, Grids,
  DBGrids, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label2: TLabel;
    Label1: TLabel;
    C_table: TComboBox;
    C_data: TComboBox;
    Button1: TButton;
    Panel2: TPanel;
    L_field: TListBox;
    DBGrid1: TDBGrid;
    B_view: TButton;
    B_close: TButton;
    Table1: TTable;
    DataSource1: TDataSource;
    Query1: TQuery;
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelWorkbook1: TExcelWorkbook;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    procedure Button2Click(Sender: TObject);
    procedure C_dataChange(Sender: TObject);
    procedure C_tableChange(Sender: TObject);
    procedure B_viewClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    Procedure Excel_App(DBGrid:TDBgrid);
    procedure B_closeClick(Sender: TObject);
    procedure L_fieldClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses UnitExportExcel, UnitDataModule, ADODB;

{$R *.dfm}





Procedure TForm1.Excel_App(DBGrid:TDBgrid);
var
 //定义数据转出时的行列变量
 i,row,column:integer;
 Query:TDataSet;
Begin
 //连接EXCEL
 //---未安装Excel，结束程序
 Try
  ExcelApplication1.Connect;
 Except
  MessageDlg('是否正确安装了Excel?',mtError,[Mbok],0);
 Abort;
 End;
 //------
//**完成工作表连接
 ExcelApplication1.Visible[0]:=True;
 ExcelApplication1.Caption:='数据转出';
 ExcelApplication1.Workbooks.Add(Null,0);
 ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
 ExcelWorksheet1.ConnectTo (ExcelWorkbook1.Worksheets[1] as _Worksheet);
//****Excel连接完成//

//----开始完成数据导出----//
//设置第一行表头
 for i:=1 to DBGrid.FieldCount do
 begin
   ExcelWorksheet1.Cells.Item[1,i]:=DBGrid.Fields[i-1].Fieldname;
 end;
//开始导出内容
 Query:=DBGrid.DataSource.DataSet;
 row:=2;
 with Query do
 begin
  first;
  While not eof do
  begin
   column:=1;
   for i:=1 to fieldcount do
   begin
    ExcelWorksheet1.Cells.Item[row,column]:=fields[i-1].value;
    column:=column+1;
   end;
   next;
   row:=row+1;
  end;
 end;
 //内容导出完成
 ExcelApplication1.Disconnect;
end;








procedure TForm1.C_dataChange(Sender: TObject);
begin
 C_table.Clear;  //清空下拉列表框
 Try
  Session.GetTableNames(C_data.Items[C_data.itemindex],'',True,False,
                        C_table.Items);
  //将指定的数据源的数据表加载到下拉列表中
 Except
  raise;
  exit;
 end;
end;



procedure TForm1.C_tableChange(Sender: TObject);
var
 field: integer;
begin
 Table1.Close;
 L_field.Clear;  //清空列表框
 Table1.DatabaseName:=C_data.Items[C_data.itemindex];  //指定数据源
 Table1.TableName:=C_table.Items[C_table.itemindex];  //指定数据表
 Table1.Open;  //打开数据表
 for field:=0 to Table1.FieldCount-1 do
  L_field.Items.Add(Table1.Fields[field].DisplayName);  //加载数据表中的字段
end;





procedure TForm1.B_viewClick(Sender: TObject);
var
 str: String;
 i: integer;
begin
 if B_view.Enabled then
  begin
   str:='Select ';
   for i:=0 to L_field.Items.Count-1 do
    if L_field.Selected[i] then
     str:=str+L_field.Items[i]+',';
   System.Delete(str,Length(str),2);  //去掉末尾的逗号
   str:=str+' From '+C_table.Items[C_table.itemindex];
   Query1.Close;
   Query1.DatabaseName:=C_data.Items[C_data.itemindex];  //指定数据源
   Query1.SQL.Clear;
   Query1.SQL.Add(str);  //加载SQL语句
   Try
    Query1.Prepare;
    Query1.Open;
    Button1.Enabled:=true;
    Bitbtn1.Enabled:=true;
    Bitbtn2.Enabled:=true;
    Bitbtn3.Enabled:=true;
    Bitbtn4.Enabled:=true;
   Except
    On E: EDatabaseError do
     MessageDlg(E.Message,Mtinformation,[mbok],0);
   end;
  end;
end;



procedure TForm1.Button3Click(Sender: TObject);
begin
if Edit1.Text='YES' then
  begin
     try
       FrmExportExcel:=TFrmExportExcel.Create(Application);
       FrmExportExcel.ShowModal;
     finally
       FrmExportExcel.Free;
     end;
   end
  else
     begin
       Showmessage('请先设置要连接的数据库^-^');
       Button2.SetFocus;
     end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with DM.AdoConnection1 do
  begin
    Close;
    if EditConnectionString(DM.AdoConnection1) then
    try
      Connected:=true;
      Edit1.Text:='YES';
      ShowMessage('连接成功^-^!');
      Button3.SetFocus;
    except
      ShowMessage('连接数据库错误，请重新设置连接!');
    end;
  end;
end;




procedure TForm1.Button1Click(Sender: TObject);
begin
if query1.Active=true then
  Excel_App(DBGrid1);
end;

procedure TForm1.B_closeClick(Sender: TObject);
begin
 Close;
end;



procedure TForm1.L_fieldClick(Sender: TObject);
begin
B_view.Enabled:=(L_field.SelCount>0);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 B_close.SetFocus;  //退出按钮获得焦点
 Session.GetAliasNames(C_data.Items);  //将系统中全部的数据源加载到下拉列表中
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
DataSource1.DataSet.First;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
DataSource1.DataSet.Prior;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
DataSource1.DataSet.Next;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
DataSource1.DataSet.Last;
end;

end.