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

📄 unit1.pas

📁 DBGridEh多表头输出到Excel.zip
💻 PAS
字号:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DBGridEh1: TDBGridEh;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelWorkbook1: TExcelWorkbook;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ExportMultiTitle;

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  conStr:string;
  i :integer;
begin
  conStr:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=';
  conStr:=conStr+ExtractFilePath(Application.ExeName)+'test.mdb;';
  conStr:=conStr+'Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database="";Jet OLEDB:Registry Path="";Jet OLEDB:Database Password="";';
  conStr:=conStr+'Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;';
  conStr:=conStr+'Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";';
  conStr:=conStr+'Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don''t Copy Locale on Compact=False;';
  conStr:=conStr+'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
  ADOConnection1.ConnectionString:=conStr;
  ADOConnection1.Open;
  ADOQuery1.Open;
  for i:=0 to AdoQuery1.Fields.Count-1 do
    combobox1.Items.Add(AdoQuery1.Fields[i].FieldName);
  ComboBox1.ItemIndex:=0;
  ComboBox1.OnChange(Self);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ADOQuery1.Close;
  ADOConnection1.Close;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  Edit1.Text:=ADOQuery1.Fields[ComboBox1.ItemIndex].DisplayLabel;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOQuery1.Fields[ComboBox1.ItemIndex].DisplayLabel:=Edit1.Text;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i,j:Integer;
  dT,dL,dR,dB:Integer;
  Ra:Variant;
begin
  Try
    ExcelApplication1.Connect;
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));
    ExcelWorkSheet1.ConnectTo(ExcelWorkBook1.Sheets[1] as _WorkSheet);
    ExcelApplication1.Caption := '通用客户打印调用 Microsoft Excel';
    ExcelApplication1.Visible[0]:=True;
    ExportMyCell(ADOQuery1.Fields);
    for i:=0 to r-1 do
      for j:=0 to c-1 do
        if MyCells[i,j].Used then
        begin
          if (MyCells[i,j].Rect.Top=MyCells[i,j].Rect.Bottom)
            and (MyCells[i,j].Rect.Left=MyCells[i,j].Rect.Right) then
          begin
            dT:=MyCells[i,j].Rect.Top+1;
            dL:=MyCells[i,j].Rect.Left+1;
            ExcelWorksheet1.Cells.Item[dt,dl]:=MyCells[i,j].Text;
          end
          else
          begin
            dT:=MyCells[i,j].Rect.Top+1;
            dL:=MyCells[i,j].Rect.Left+1;
            dR:=MyCells[i,j].Rect.Right+1;
            dB:=MyCells[i,j].Rect.Bottom+1;
          //合并
            ExcelWorksheet1.Cells.Item[dt,dl]:=MyCells[i,j].Text;
            Ra:=ExcelWorksheet1.Range[ExcelWorksheet1.Cells.Item[dt,dl],ExcelWorksheet1.Cells.Item[db,dr]];
            Ra.MergeCells:=True;
          end;
        end;
    ExcelWorkSheet1.Columns.AutoFit;
  Finally
    ExcelWorkSheet1.Disconnect;
    ExcelWorkBook1.Disconnect;
    ExcelApplication1.Disconnect;
    Ra:=Unassigned;
  end;
end;

end.

⌨️ 快捷键说明

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