使用EXCEL制作通用打印模块

{
eclApp.ActiveSheet.PageSetup.PaperSize := xlPaperA3;       //设置纸张的类型
   eclApp.ActiveSheet.PageSetup.Orientation := xlLandscape; //设置是横向打印还是纵向打印
   eclApp.ActiveSheet.PageSetup.PrintTitleRows := '$3:$5';　　//设置表头重复如果多页的情况下
   eclApp.ActiveSheet.PageSetup.CenterFooter := '第&P页，共 &N 页'; //设置页码问题
   }

unit U_general_print;
{$WARNINGS OFF}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, ComCtrls, Db, variants, comobj, excelxp;

type
  TfrmPrint = class(TForm)
    Panel1: TPanel;
    SrcLabel: TLabel;
    DstLabel: TLabel;
    IncludeBtn: TSpeedButton;
    IncAllBtn: TSpeedButton;
    ExcludeBtn: TSpeedButton;
    ExAllBtn: TSpeedButton;
    SrcList: TListBox;
    DstList: TListBox;
    Panel2: TPanel;
    btnOK: TSpeedButton;
    btnCancel: TSpeedButton;
    Label6: TLabel;
    procedure IncludeBtnClick(Sender: TObject);
    procedure ExcludeBtnClick(Sender: TObject);
    procedure IncAllBtnClick(Sender: TObject);
    procedure ExcAllBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ExAllBtnClick(Sender: TObject);
    procedure DstListDblClick(Sender: TObject);
    procedure SrcListDblClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FDataSet: TDataSet;
    FHeader1: string; //单据头
    FHeader2: string;
    FHeader3: string;
    FFooter1: string; //单据尾
    FFooter2: string;
    FFooter3: string;
    varexcel: variant; //变体变量，指向创建的EXCEL对象
    range: variant; //变体变量，作为EXCEL一块区域的对象
    procedure ExportDataToExcel; //打印数据
    function GetFieldName(const s:string):string;
  public
    { Public declarations }
    procedure MoveSelected(List: TCustomListBox; Items: TStrings);
    procedure SetItem(List: TListBox; Index: Integer);
    function GetFirstSelection(List: TCustomListBox): Integer;
    procedure SetButtons;
  end;

var
  frmPrint: TfrmPrint;

procedure Execute(DataSet: TDataSet; DefFeildList:TStringList;
  const Header1, Header2, Header3, Footer1, Footer2, Footer3: string);

implementation

{$R *.DFM}

var
  myStr: string;

procedure Execute(DataSet: TDataSet; DefFeildList:TStringList;
  const Header1, Header2, Header3, Footer1, Footer2, Footer3: string);
var
  i: Integer;
begin
  frmPrint := TfrmPrint.Create(nil);
  frmPrint.FDataSet := DataSet;
  if DefFeildList<>nil then frmPrint.DstList.Items.Assign(DefFeildList);
  frmPrint.FHeader1 := Header1;
  frmPrint.FHeader2 := Header2;
  frmPrint.FHeader3 := Header3;
  frmPrint.FFooter1 := Footer1;
  frmPrint.FFooter2 := Footer2;
  frmPrint.FFooter3 := Footer3;
  frmPrint.SrcList.Items.Clear;
  for i := 0 to DataSet.FieldCount - 1 do begin
    frmPrint.SrcList.Items.Add(DataSet.Fields[i].DisplayLabel);
  end;
  frmPrint.ShowModal;
end;

//操作两个列表框之间的数据移动
procedure TfrmPrint.IncludeBtnClick(Sender: TObject);
var
  Index: Integer;
begin
  Index := GetFirstSelection(SrcList);
  MoveSelected(SrcList, DstList.Items);
  SetItem(SrcList, Index);
end;

procedure TfrmPrint.ExcludeBtnClick(Sender: TObject);
var
  Index: Integer;
begin
  Index := GetFirstSelection(DstList);
  MoveSelected(DstList, SrcList.Items);
  SetItem(DstList, Index);
end;

procedure TfrmPrint.IncAllBtnClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to SrcList.Items.Count - 1 do
    DstList.Items.AddObject(SrcList.Items[I],
      SrcList.Items.Objects[I]);
  SrcList.Items.Clear;
  SetItem(SrcList, 0);
end;

procedure TfrmPrint.ExcAllBtnClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to DstList.Items.Count - 1 do
    SrcList.Items.AddObject(DstList.Items[I], DstList.Items.Objects[I]);
  DstList.Items.Clear;
  SetItem(DstList, 0);
end;

procedure TfrmPrint.ExAllBtnClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to DstList.Items.Count - 1 do
    SrcList.Items.AddObject(DstList.Items[I], DstList.Items.Objects[I]);
  DstList.Items.Clear;
  SetItem(DstList, 0);
end;

procedure TfrmPrint.DstListDblClick(Sender: TObject);
begin
  excludebtn.click;
end;

procedure TfrmPrint.SrcListDblClick(Sender: TObject);
begin
  includebtn.click;
end;

procedure TfrmPrint.MoveSelected(List: TCustomListBox; Items: TStrings);
var
  I: Integer;
begin
  for I := List.Items.Count - 1 downto 0 do
    if List.Selected[I] then
    begin
      Items.AddObject(List.Items[I], List.Items.Objects[I]);
      List.Items.Delete(I);
    end;
end;

procedure TfrmPrint.SetButtons;
var
  SrcEmpty, DstEmpty: Boolean;
begin
  SrcEmpty := SrcList.Items.Count = 0;
  DstEmpty := DstList.Items.Count = 0;
  IncludeBtn.Enabled := not SrcEmpty;
  IncAllBtn.Enabled := not SrcEmpty;
  ExcludeBtn.Enabled := not DstEmpty;
  ExAllBtn.Enabled := not DstEmpty;
end;

function TfrmPrint.GetFieldName(const s: string): string;
var
  i: Integer;
begin
  for i := 0 to FDataSet.FieldCount -1 do begin
    if FDataSet.Fields[i].DisplayLabel = s then begin
      Result := FDataSet.Fields[i].FieldName;
      Break;
    end;
  end;
end;

function TfrmPrint.GetFirstSelection(List: TCustomListBox): Integer;
begin
  for Result := 0 to List.Items.Count - 1 do
    if List.Selected[Result] then Exit;
  Result := LB_ERR;
end;

procedure TfrmPrint.SetItem(List: TListBox; Index: Integer);
var
  MaxIndex: Integer;
begin
  with List do
  begin
    SetFocus;
    MaxIndex := List.Items.Count - 1;
    if Index = LB_ERR then Index := 0
    else if Index > MaxIndex then Index := MaxIndex;
    Selected[Index] := True;
  end;
  SetButtons;
end;

//===============================

//当窗体激活的时候

procedure TfrmPrint.FormActivate(Sender: TObject);
begin
  if srclist.Items.count > 0 then
  begin
    includebtn.Enabled := true;
    IncAllBtn.Enabled := true;
  end;
  if dstlist.Items.count > 0 then
  begin
    ExcludeBtn.Enabled := True;
    ExAllBtn.Enabled := true;
  end;
end;

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

//将数据导入到EXCEL中

procedure TfrmPrint.ExportDataToExcel;
var
  i, j, k: integer;
  xxx1: string;
  xr: string;
begin
  if frmPrint.dstlist.items.count = 0 then
  begin
    application.messagebox('没有选择目标字段!', '提示信息', mb_iconwarning + mb_defbutton1);
    exit;
  end;
  Label6.Caption := '正在载入Excel,请稍候......';
  Label6.Refresh;
  try
    screen.cursor := crHourGlass;
    try
      //创建EXCEL对象
      varexcel := createoleobject('excel.application');
      if not varisempty(varexcel) then
      begin
        //添加工作簿
        varexcel.workbooks.add;
        varexcel.workbooks[1].worksheets[1].name := '数据库信息';
      end;
    except
      application.messagebox('请确认是否安装Excel?', '提示信息：', mb_iconquestion + mb_defbutton1);
      exit;
    end;
    begin
      //写入列标题
      range := varexcel.workbooks[1].worksheets[1].columns;
      for i := 0 to frmPrint.dstlist.Items.count - 1 do begin
        varexcel.workbooks[1].worksheets[1].cells[4, i + 1].value := frmPrint.dstlist.items.strings[i];
        varexcel.workbooks[1].worksheets[1].cells[4, i + 1].Font.bold := true;
        range.columns[i + 1].columnwidth := 10;
      end;
      try
        try
          //循环写入数据到EXCEL中
          frmPrint.FDataSet.first;
          j := 5;
          while not frmPrint.FDataSet.eof do begin
            for i := 0 to frmPrint.dstlist.Items.count - 1 do begin
              xr := '''' + frmPrint.FDataSet.fieldbyname(GetFieldName(frmPrint.dstlist.items.strings[i])).AsString;
              varexcel.workbooks[1].worksheets[1].cells[j, i + 1].value := xr;
            end;
            frmPrint.FDataSet.next;
            j := j + 1;
          end;
          //写入单据尾
          varexcel.workbooks[1].worksheets[1].cells[j, 1].value := Self.FFooter1;
          varexcel.workbooks[1].worksheets[1].cells[j + 1, 1].value := Self.FFooter2;
          varexcel.workbooks[1].worksheets[1].cells[j + 2, 1].value := Self.FFooter3;
        except
        end;
      finally
        frmPrint.FDataSet.enablecontrols;
        frmPrint.Label6.Caption := '';
        //数据表格画线
        k := i - 1 + ord('A');
        xxx1 := chr(k);
        myStr := xxx1;
        xxx1 := 'A4:' + xxx1 + inttostr(j - 1);
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.borders.linestyle := xlcontinuous;
        //单据尾区域合并
        xxx1 := 'a' + inttostr(j) + ':' + myStr + inttostr(j);
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.MergeCells := True;
        xxx1 := 'a' + inttostr(j + 1) + ':' + myStr + inttostr(j + 1);
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.MergeCells := True;
        xxx1 := 'a' + inttostr(j + 2) + ':' + myStr + inttostr(j + 2);
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.MergeCells := True;
        //单据头区域合并  标题列居中
        xxx1 := 'a1:' + myStr + '1';
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.HorizontalAlignment := xlCenter;
        range.VerticalAlignment := xlCenter;
        range.MergeCells := True;
        xxx1 := 'a2:' + mystr + '2';
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.MergeCells := True;
        xxx1 := 'a3:' + mystr + '3';
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.MergeCells := True;
        //写入单据头
        varexcel.workbooks[1].worksheets[1].range['a1:a1'] := Self.FHeader1;
        varexcel.workbooks[1].worksheets[1].range['a2:a2'] := Self.FHeader2;
        varexcel.workbooks[1].worksheets[1].range['a3:a3'] := Self.FHeader3;
        //对报表标题进行修饰
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.name := '楷体';
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.size := '18';
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.fontstyle := 'bold';
        varexcel.ActiveSheet.PageSetup.CenterFooter := '第&P页，共&N页';
        varexcel.visible := true;
      end;
    end;
  finally
    screen.cursor := crArrow;
  end;
end;

procedure TfrmPrint.btnCancelClick(Sender: TObject);
begin
  close;
end;

procedure TfrmPrint.btnOKClick(Sender: TObject);
begin
  //导入数据到EXCEL
  ExportDataToExcel;
end;
end.

object frmPrint: TfrmPrint
  Left = 287
  Top = 111
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  Caption = #25171#21360#36873#25321#31383#21475
  ClientHeight = 348
  ClientWidth = 363
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnActivate = FormActivate
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 363
    Height = 317
    Align = alClient
    BevelInner = bvLowered
    TabOrder = 0
    object SrcLabel: TLabel
      Left = 12
      Top = 10
      Width = 48
      Height = 12
      Caption = #21407#26377#23383#27573
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ParentFont = False
    end
    object DstLabel: TLabel
      Left = 206
      Top = 10
      Width = 48
      Height = 12
      Caption = #30446#26631#23383#27573
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ParentFont = False
    end
    object IncludeBtn: TSpeedButton
      Left = 171
      Top = 38
      Width = 24
      Height = 22
      Caption = '>'
      Enabled = False
      Flat = True
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ParentFont = False
      OnClick = IncludeBtnClick
    end
    object IncAllBtn: TSpeedButton
      Left = 171
      Top = 88
      Width = 24
      Height = 22
      Caption = '>>'
      Enabled = False
      Flat = True
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ParentFont = False
      OnClick = IncAllBtnClick
    end
    object ExcludeBtn: TSpeedButton
      Left = 171
      Top = 136
      Width = 24
      Height = 22
      Caption = '<'
      Enabled = False
      Flat = True
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ParentFont = False
      OnClick = ExcludeBtnClick
    end
    object ExAllBtn: TSpeedButton
      Left = 171
      Top = 186
      Width = 24
      Height = 22
      Caption = '<<'
      Enabled = False
      Flat = True
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ParentFont = False
      OnClick = ExAllBtnClick
    end
    object SrcList: TListBox
      Left = 11
      Top = 29
      Width = 150
      Height = 276
      Cursor = crArrow
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ImeName = #20013#25991' ('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
      ItemHeight = 12
      MultiSelect = True
      ParentFont = False
      TabOrder = 0
      OnDblClick = SrcListDblClick
    end
    object DstList: TListBox
      Left = 206
      Top = 29
      Width = 150
      Height = 276
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ImeName = #20013#25991' ('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
      ItemHeight = 12
      MultiSelect = True
      ParentFont = False
      TabOrder = 1
      OnDblClick = DstListDblClick
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 317
    Width = 363
    Height = 31
    Align = alBottom
    BevelInner = bvLowered
    TabOrder = 1
    object btnOK: TSpeedButton
      Left = 208
      Top = 4
      Width = 68
      Height = 22
      Caption = #30830' '#23450
      Flat = True
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000120B0000120B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555555555
        555555555555555555555555555555555555555555FF55555555555559055555
        55555555577FF5555555555599905555555555557777F5555555555599905555
        555555557777FF5555555559999905555555555777777F555555559999990555
        5555557777777FF5555557990599905555555777757777F55555790555599055
        55557775555777FF5555555555599905555555555557777F5555555555559905
        555555555555777FF5555555555559905555555555555777FF55555555555579
        05555555555555777FF5555555555557905555555555555777FF555555555555
        5990555555555555577755555555555555555555555555555555}
      NumGlyphs = 2
      ParentFont = False
      OnClick = btnOKClick
    end
    object btnCancel: TSpeedButton
      Left = 286
      Top = 4
      Width = 68
      Height = 22
      Caption = #21462' '#28040
      Flat = True
      Font.Charset = GB2312_CHARSET
      Font.Color = clBlack
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000130B0000130B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
        3333333333FFFFF3333333333999993333333333F77777FFF333333999999999
        33333337777FF377FF3333993370739993333377FF373F377FF3399993000339
        993337777F777F3377F3393999707333993337F77737333337FF993399933333
        399377F3777FF333377F993339903333399377F33737FF33377F993333707333
        399377F333377FF3377F993333101933399377F333777FFF377F993333000993
        399377FF3377737FF7733993330009993933373FF3777377F7F3399933000399
        99333773FF777F777733339993707339933333773FF7FFF77333333999999999
        3333333777333777333333333999993333333333377777333333}
      NumGlyphs = 2
      ParentFont = False
      OnClick = btnCancelClick
    end
    object Label6: TLabel
      Left = 11
      Top = 10
      Width = 6
      Height = 12
      Font.Charset = ANSI_CHARSET
      Font.Color = clWindowText
      Font.Height = -12
      Font.Name = #23435#20307
      Font.Style = []
      ParentFont = False
    end
  end
end

procedure TFormRuKu.dxBarButton2Click(Sender: TObject);
var
  h1, h2, h3, f1, f2, f3: string;
  list: TStringList;
  zje: Double;
begin
  inherited;
  h1 := gShop + '进(退)货单';
  h2 := '日期：' + formatdatetime('yyyy-mm-dd', cxDateEdit1.Date) + '    单号：' + cxtextedit1.Text + '    供应商：' + cxbuttonedit1.Text;
  h3 := '单据类型：' + cxcombobox1.Text + '    备注：' + cxtextedit2.Text;
  zje := Double(cxGrid1DBTableView1.DataController.Summary.FooterSummaryValues[1]);
  f1 := '合计金额小写：' + floattostr(zje) + '（元）';
  f2 := '合计金额大写：' + getrmb(zje);
  f3 := '制表：' + guser.name + '    验收：          ' + '主管：';
  list := TStringList.Create;
  list.Delimiter := ',';
  list.DelimitedText := '编码,品名规格,单位,数量,进价,金额';
  U_general_print.Execute(dm1.qryRuKu, list, h1, h2, h3, f1, f2, f3);
  list.Free;
end;