unit1.pas

DELPHI操作技巧

//*功能：将EXECL中的数据导入ACCESS进行统计，
//      再将统计数据导出到EXECL
//*作者：宋建新
//*版本：V1.0
//*日期：2003.07.27
//*最后修改日期：2003.07.27

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ComObj, Grids, DBGrids, Buttons, ExtCtrls, DB, DBTables,
  ComCtrls, ADODB, Menus;

type
  TFrmExcel = class(TForm)
    OpenDialog1: TOpenDialog;
    ADOConn: TADOConnection;
    Tblsystem: TADOTable;
    DSsource: TDataSource;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    BitBtn1: TBitBtn;
    btnin: TBitBtn;
    grdlist: TDBGrid;
    Panel1: TPanel;
    Tblsource: TADOTable;
    ADOComm: TADOCommand;
    TblsourceField: TADOTable;
    QryTmp: TADOQuery;
    Panel2: TPanel;
    Panel3: TPanel;
    btngroup: TBitBtn;
    btntotal: TBitBtn;
    Panel4: TPanel;
    Panel5: TPanel;
    btnshow: TBitBtn;
    Labgroup: TLabel;
    Labtotal: TLabel;
    Grdtotal: TDBGrid;
    Pangroup: TPanel;
    LBxgroupall: TListBox;
    Label4: TLabel;
    BitBtn5: TBitBtn;
    LBxgroupsele: TListBox;
    Label5: TLabel;
    Label6: TLabel;
    Pantotal: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    LBxtotalall: TListBox;
    BitBtn6: TBitBtn;
    LBxtotalsele: TListBox;
    Panshow: TPanel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    LBxshowall: TListBox;
    BitBtn7: TBitBtn;
    LBxshowsele: TListBox;
    Button1: TButton;
    Panel9: TPanel;
    labavg: TLabel;
    btnexectotal: TBitBtn;
    Tbltotal: TADOTable;
    DStotal: TDataSource;
    TabSheet3: TTabSheet;
    Panel6: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Edttitle: TEdit;
    btnExit: TBitBtn;
    btnoutyes: TBitBtn;
    btnout: TBitBtn;
    Label15: TLabel;
    edtman: TEdit;
    Label17: TLabel;
    Label1: TLabel;
    Label16: TLabel;
    Label18: TLabel;
    CBxnopage: TComboBox;
    btn: TBitBtn;
    Panel7: TPanel;
    Edtexcelname: TEdit;
    function Getexepath():string; //取执行文件的路径
    function Getlbxsele(listboxname:Tlistbox):string;
    Procedure  displaylist(listboxname:Tlistbox;fieldname:string;tablename:string;condition:string;
               orderbyfieldname:string);
    procedure showdatafield();
    procedure btninClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure LBxgroupallDblClick(Sender: TObject);
    procedure LBxgroupseleDblClick(Sender: TObject);
    procedure LBxtotalallDblClick(Sender: TObject);
    procedure LBxtotalseleDblClick(Sender: TObject);
    procedure LBxshowallDblClick(Sender: TObject);
    procedure LBxshowseleDblClick(Sender: TObject);
    procedure btngroupClick(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure btntotalClick(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure btnshowClick(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure btnexectotalClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnoutyesClick(Sender: TObject);
    procedure btnoutClick(Sender: TObject);
    procedure btnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmExcel: TFrmExcel;
  Gobdatapath:string;

implementation

{$R *.dfm}

function TFrmexcel.Getexepath():string;
var
   Tmppath:string;
begin
   Tmppath:=Trim(ExtractFileDir(Application.Exename));
   Getexepath:=Tmppath;
end;

//将表中的字段值显示在列表框中
Procedure  TFrmexcel.displaylist(listboxname:Tlistbox;fieldname:string;tablename:string;condition:string;
orderbyfieldname:string);
begin
  with qrytmp do
  begin
    close;
    sql.Clear;
    if orderbyfieldname<>'' then
         sql.Add('select distinct *  from '+tablename )
    else
         sql.Add('select distinct '+fieldname+' from '+tablename );
    sql.add('where  '+fieldname+'<>'''' ' );
    if condition<>'' then  sql.add(' and  '+condition);
    if orderbyfieldname<>'' then  sql.Add(' order by '+orderbyfieldname);
    open;
    listboxname.items.Clear;

     if not isempty then
       with listboxname do
       begin
         while not eof do
          begin
              items.Add(trim(fieldbyname(fieldname).asstring));
               next;
          end;
       end;
     close;
   end;
end;

//取列表框中被选定的值
function TFrmExcel.Getlbxsele(listboxname:Tlistbox):string;
var i:integer;
    listvalues:string;
begin
    with listboxname do
    begin
      For I:=0 To (items.Count-1) Do
      If  Selected[I] Then
      begin
       listvalues:=items.strings[i];
      end;
    end;
   Getlbxsele:=trim(listvalues);
end;

//将选择情况显示出来
procedure TFrmExcel.showdatafield();
begin
labgroup.Caption:='';
labtotal.Caption:='';
labavg.Caption:='' ;
    
with TblsourceField do
begin
  close;
  open;
  first;
  while  not Eof do
  begin
   if trim(fieldbyname('fgroup').AsString)='1' then
   begin
     if length(trim(labgroup.Caption))=0 then
     begin
       labgroup.Caption:=trim(fieldbyname('ffieldname').AsString);
     end
     else begin
       labgroup.Caption:=labgroup.Caption+','+trim(fieldbyname('ffieldname').AsString);
     end;
    end;

    if trim(fieldbyname('ftotal').AsString)='1' then
    begin
     if length(trim(labtotal.Caption))=0 then
     begin
       labtotal.Caption:=trim(fieldbyname('ffieldname').AsString);
     end
     else begin
       labtotal.Caption:=labtotal.Caption+','+trim(fieldbyname('ffieldname').AsString);
     end;
    end;

    if trim(fieldbyname('favg').AsString)='1' then
    begin
     if length(trim(labavg.Caption))=0 then
     begin
       labavg.Caption:=trim(fieldbyname('ffieldname').AsString);
     end
     else begin
       labavg.Caption:=labavg.Caption+','+trim(fieldbyname('ffieldname').AsString);
     end;
    end;

    next;
  end;
end;
end;

procedure TFrmExcel.btninClick(Sender: TObject);
var
  xlsFilename,strpage:string;
  nopage:integer;
  eclApp,WorkBook,sheet:Variant;   //声明为OLE Automation 对象
  i,j,k,h,l:integer;
  firstrow,firstcol,lastcol:integer;//字段名的起始位置 （行，列）
  addfield,exceldata,datastring:string;
begin
   Tblsource.Active:=false;
   Tbltotal.Active:=False;
   btnexectotal.Enabled:=false;
   btnoutyes.Enabled:=false;
   btnout.Enabled:=false;

  xlsFilename:=trim(Edtexcelname.Text);
  if length(xlsFilename)=0 then
  begin
     ShowMessage('您未选择 Excel 文件！');
     Exit;
  end;

  nopage:=cbxnopage.ItemIndex+1;
  //打开选定的EXCEL文件
  try
    eclApp:=CreateOleObject('Excel.Application');
    //WorkBook:=CreateOleobject('Excel.Sheet');
  except
     ShowMessage('您的机器里未安装Microsoft Excel。');
     Exit;
  end;

  frmExcel.Cursor:=crHourGlass;
  try
    WorkBook:=eclApp.workBooks.Open(xlsFileName);
    if  nopage>eclapp.ActiveWorkbook.Worksheets.count then
    begin
        strpage:=inttostr(eclapp.ActiveWorkbook.Worksheets.count);
        showmessage('选择的页数大于工作簿的页数，工作簿的页数为'+strpage);
        exit;
    end;
    sheet:=eclapp.ActiveWorkbook.Worksheets[nopage];

    with tblsystem do
    begin
        edit;
        fieldbyname('Ffilepath').AsString:=xlsFileName;
        post;
    end;

    //查找EXECL的字段名的 起始位置
    //如果找到有效的起始位置 就进行初始话工作
    firstrow:=0;
    firstcol:=0;
    lastcol:=0;

    for i:=1 to 4 do
    begin
       for j:=1  to 4 do
       begin
           if  (firstrow<>0)  then break;
           if  Length(trim(sheet.cells[j,i]))<>0 then
           begin
               firstrow:=j;
               firstcol:=i;
               break;
           end
       end;
    end;

    if firstrow=0 then
    begin
      showmessage('请修改你的EXCEL文件,数据的起始位置不能大于第四列');
      exit;
    end;

    //进行初始化工作
    With Tblsystem do
    begin
      Active:=True;
      if trim(fieldbyname('Fsource').AsString)='是' then
      begin
        Tblsource.Active:=False;

        adocomm.CommandText:='';
        adocomm.CommandText:='Drop Table Tsource';
        adocomm.Execute;

        edit;
        fieldbyname('Fsource').AsString:='否';
        post;
      end;
    end;

    labgroup.Caption:='';
    labtotal.Caption:='';
    lbxgroupall.Items.Clear;
    lbxgroupsele.Items.Clear;
    lbxtotalall.Items.Clear;
    lbxtotalsele.Items.Clear;
    lbxshowall.Items.Clear;
    lbxshowsele.Items.Clear;


    TblsourceField.close;

    with adocomm do
    begin
        commandtext:='';
        commandtext:='delete From TsourceField';
        Execute;
    end;

    //生成Tsource 数据库
    with adocomm do
    begin
        commandtext:='';
        commandtext:='CREATE TABLE Tsource (fsourceid  char(30)  PRIMARY KEY CLUSTERED)';
        Execute;
    end;
    With Tblsystem do
    begin
        edit;
        fieldbyname('Fsource').AsString:='是';
        post;
    end;

    //读取字段名 并 将字段名保存在 TsourceField 表中
    k:=firstcol;

    TblsourceField.Open;

    while k>0 do
    begin
        if Length(trim(sheet.cells[firstrow,k]))<>0 then
        begin
           Tblsourcefield.Append;
           Tblsourcefield.FieldByName('ffieldname').AsString:=
             sheet.cells[firstrow,k];
           Tblsourcefield.FieldByName('favg').AsString:='0';
           Tblsourcefield.FieldByName('ftotal').AsString:='0';
           Tblsourcefield.FieldByName('fgroup').AsString:='0';
           Tblsourcefield.Post;
           addfield:=Tblsourcefield.FieldByName('ffieldname').AsString;
           with adocomm do    //修改Tsource 的字段
           begin
            commandtext:='';
            commandtext:='ALTER TABLE Tsource ADD '+addfield+' char(70) null';
            Execute;
           end;
           lastcol:=k;
           k:=k+1;
        end
        else begin
           k:=0;
        end;
    end;

    //导入数据
    h:=firstrow+1;
    while H>0 do
    begin
       datastring:='';
       For l:=firstcol to lastcol do
       Begin
           if h=0 then break;
           exceldata:=sheet.cells[h,l];
           datastring:=datastring+','''+trim(exceldata)+'''';
           if (l=lastcol) then
           begin
               if (length(datastring)>((lastcol-firstcol)+1)*3) then
               begin
                  with adocomm do
                  begin
                     datastring:=datastring+')';
                     CommandText:='';
                     CommandText:='INSERT INTO Tsource VALUES ('''+inttostr(h)+''''+datastring ;
                     Execute;
                  end;
                  h:=h+1;
               end
               else begin
                  h:=0;
               end;
           end;
       end;
    end;

    //显示数据
    Tblsource.Active:=True;
    with grdlist.Columns do
    begin
       for  i:=0 to (Count-1) do
       begin
           items[i].Width:=60;
       end;
       items[0].Visible:=false;
    end;
    btnexectotal.Enabled:=True;

    button1.Click;
  finally
     frmExcel.Cursor:=crDefault;
     WorkBook.Close;
     eclApp.Quit;
     eclApp:=Unassigned;
  end;
end;


procedure TFrmExcel.FormCreate(Sender: TObject);
var
ConnectStr:String;
begin
  Gobdatapath:=GetexePath()+'\data\ExcelCtr.mdb';
  ConnectStr:='Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data Source=';
  ConnectStr:=ConnectStr+Gobdatapath+';';
  Adoconn.ConnectionString:='';
  Adoconn.ConnectionString:=ConnectStr;
  Adoconn.LoginPrompt:=false;
  Adoconn.Connected:=True;
  Tblsystem.Open;
  TblsourceField.Open;