⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 delphi 操作excel的例程
💻 PAS
字号:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, ExtCtrls, StdCtrls, DB, ADODB;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Panel3: TPanel;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    ADOConnection2: TADOConnection;
    DataSource2: TDataSource;
    ADOQuery2: TADOQuery;
    Button3: TButton;
    DataSource3: TDataSource;
    ADOQuery3: TADOQuery;
    Button4: TButton;
    SaveDialog1: TSaveDialog;
    DBGridEh2: TDBGrid;
    DBGridEh3: TDBGrid;
    DBGridEh1: TDBGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
  procedure DBGridToExcel(Ext, sFilter: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}
procedure TFrmMain.DBGridToExcel(Ext, sFilter: string);
begin
  SaveDialog1.FileName := '导出Excel';
  if SaveDialog1.Execute then
  begin
    if UpperCase(Copy(SaveDialog1.FileName, Length(SaveDialog1.FileName) - 3, 4)) <> UpperCase(Ext) then
      SaveDialog1.FileName := SaveDialog1.FileName + Ext;
    //SaveDBGridEhToExportFile(TDBGridEhExportAsXLS, DBGridEh3, SaveDialog1.FileName,true);
  end;

end;

procedure TFrmMain.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute() then
  begin
    ADOConnection1.Close;
    ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ OpenDialog1.FileName +';Extended Properties=Excel 8.0;Persist Security Info=False';
    ADOConnection1.Open;

    ADOQuery1.Close;
    ADOQuery1.SQL.Clear;
    ADOQuery1.SQL.Text:='Select * from [Sheet1$]';
    ADOQuery1.Open;

    //DBGridEh1.OptimizeColsWidth(DBGridEh1.VisibleColumns);

  end;
end;

procedure TFrmMain.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute() then
  begin
    ADOConnection2.Close;
    ADOConnection2.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ OpenDialog1.FileName +';Extended Properties=Excel 8.0;Persist Security Info=False';
    ADOConnection2.Open;

    ADOQuery2.Close;
    ADOQuery2.SQL.Clear;
    ADOQuery2.SQL.Text:='Select * from [Sheet1$]';
    ADOQuery2.Open;

    //DBGridEh2.OptimizeColsWidth(DBGridEh2.VisibleColumns);

  end;
end;

procedure TFrmMain.Button3Click(Sender: TObject);
var
strNames,strFieldName,strWhere:string;
i:integer;
begin
  if (ADOQuery1.IsEmpty) then
  begin
    ShowMessage('请打开Excel 1');
    exit;
  end;

  if (ADOQuery1.RecordCount<=0) then
  begin
    ShowMessage('Excel 1没有数据');
    exit;
  end;

  if (ADOQuery2.IsEmpty) then
  begin
    ShowMessage('请打开Excel 2');
    exit;
  end;

  if ADOQuery2.RecordCount<=0 then
  begin
    ShowMessage('Excel 2没有数据');
    exit;
  end;

  ADOQuery2.First;
  for i:=0 to ADOQuery2.RecordCount-1 do
  begin
    strNames:=strNames + ''''+ADOQuery2.Fieldbyname('商品名称').AsString+'''';
    if i<ADOQuery2.RecordCount-1 then
      strNames:=strNames+',';

    ADOQuery2.Next;
  end;

  for i:=0 to ADOQuery1.FieldCount-1 do
  begin
    strFieldName:=ADOQuery1.Fields[i].FieldName ;
    if (Pos('名称',strFieldName)>0) or ( Pos('别名',strFieldName)>0  )  then
    begin
      strWhere:=strWhere + strFieldName + ' in ('+ strNames +')';
      if i<ADOQuery1.FieldCount-1 then
        strWhere:=strWhere+' or ';
    end;
  end;
 
  if Length(strWhere)>0 then
  begin
    ADOQuery3.Close;
    ADOQuery3.SQL.Clear;
    ADOQuery3.SQL.Text:='Select * from [Sheet1$] where '+ strWhere;
    ADOQuery3.Open;

    //DBGridEh3.OptimizeColsWidth(DBGridEh3.VisibleColumns);

  end;
end;

procedure TFrmMain.Button4Click(Sender: TObject);
begin
  if ADOQuery3.IsEmpty then
  begin
    ShowMessage('没有数据,不需要导出');
    exit;
  end;

  //DBGridToExcel('.xls', 'Excel文件|*.xls;');
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -