unit1.pas

delphi 读 excel ,并生成各种文件。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxExEdtr, DB, dxmdaset, dxCntner, dxTL, dxDBCtrl, dxDBTL,
  StdCtrls, OleServer, Excel2000,ComObj, dxDBGrid, dxPageControl,FileCtrl,GridToWord
  ,TypInfo;

type
  Tfrmmain = class(TForm)
    OpenDialog1: TOpenDialog;
    dxpage: TdxPageControl;
    GroupBox1: TGroupBox;
    btnReadExcel: TButton;
    btnQuit: TButton;
    chk: TCheckBox;
    btnExportWord: TButton;
    cbSaveFormat: TComboBox;
    Label1: TLabel;
    cbstyle: TComboBox;
    Label2: TLabel;
    procedure btnReadExcelClick(Sender: TObject);
    procedure btnQuitClick(Sender: TObject);
    procedure btnExportWordClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    gw:TGridToWord;
    procedure init();
    function DirToPath(Dir: string): string;
  public
    function func_addFieldToDmd(dmdData: TdxMemData; ftType: TFieldType; sFieldName, sDisplayLabel: string;
    iSize: integer; iDisplayWidth: integer = 0): integer;
    function CreateDxGridCol(dxg : TdxDBGrid;cds : TdxMemData; ds : TDataSource) : Integer;
    procedure CreatetabSheet(ACaption: String);
    procedure CreateDmd(ACaption: String);
    procedure DestroytabSheet(index:integer);
    procedure CreateEdit(AParent: TWinControl; ACaption: String);
    { Public declarations }
  end;

var
  frmmain: Tfrmmain;

implementation

{$R *.dfm}

procedure Tfrmmain.btnReadExcelClick(Sender: TObject);
var
  MSExcel: Variant;
  i,j,k: Integer;
  //dtype:Variant;
  temprow:integer;
  SheetName:string;
begin
  if not opendialog1.Execute then
    exit;

  init;

  MSExcel:=CreateOLEObject('Excel.Application');
  MSExcel.WorkBooks.Open(OpenDialog1.FileName);
  MSExcel.Visible:=false;
  for k:=1 to MSExcel.sheets.count do begin
    SheetName:=StringREplace(trim(MSExcel.Sheets[k].name),' ','_',[rfReplaceAll, rfIgnoreCase]);
    CreateTabSheet(SheetName);
    CreateDmd(SheetName);
    TdxMemdata(FindComponent('DMD_'+SheetName)).close;
    for i:=1 to MSExcel.Sheets[k].UsedRange.Columns.Count do
    begin
       //dtype:=MSExcel.ActiveSheet.column[i,1].value;
       if chk.Checked then
       func_addFieldToDmd(TdxMemdata(FindComponent('DMD_'+SheetName)), ftString, 'Column'+inttostr(i),MSExcel.Sheets[k].Cells[1,i].Value,255, 255)
       else
       func_addFieldToDmd(TdxMemdata(FindComponent('DMD_'+SheetName)), ftString, 'Column'+inttostr(i),'Column'+inttostr(i),255, 255);
    end;

    TdxMemdata(FindComponent('DMD_'+SheetName)).open;

    if chk.Checked then temprow:=2 else temprow:=1;

    for i:=temprow to MSExcel.Sheets[k].UsedRange.rows.Count do
    begin
      TdxMemdata(FindComponent('DMD_'+SheetName)).Append;
        for j:=1 to MSExcel.Sheets[k].UsedRange.Columns.Count do
        begin
          TdxMemdata(FindComponent('DMD_'+SheetName)).FieldByName('Column'+inttostr(j)).AsString:=MSExcel.Sheets[k].Cells[i,j].Value;
        end;
      TdxMemdata(FindComponent('DMD_'+SheetName)).post;
    end;

    TDataSource(FindComponent('DS_'+SheetName)).DataSet:=TdxMemdata(FindComponent('DMD_'+SheetName));
    CreateDxGridCol(TdxDbgrid(FindComponent('DBG_'+SheetName)),TdxMemdata(FindComponent('DMD_'+SheetName)),TDataSource(FindComponent('DS_'+SheetName)));

  end; //end for

  MSExcel.ActiveWorkBook.Close;
  MSExcel.Quit;
  
end;

function Tfrmmain.CreateDxGridCol(dxg: TdxDBGrid; cds: TdxMemData;
  ds: TDataSource): Integer;
var i : Integer;
    Column: TdxDBTreeListColumn;
begin
  //result := -1;
  dxg.ClearGroupColumns;
  dxg.DestroyColumns;
  dxg.SummaryGroups.Clear;
  dxg.DataSource := ds;

  for i := 1 to cds.FieldCount-1 do
  begin
    if cds.Fields.Fields[i].Tag >= 2 then continue;
    Column := dxg.CreateColumnEx(dxg.GetDefaultFieldColumnClass(cds.Fields[i]), dxg);
    Column.FieldName := cds.Fields[i].FieldName;
    Column.Name := dxg.Name + Column.FieldName;
    if cds.Fields.Fields[i].Tag = 1
      then Column.Visible := false
      else begin
        Column.Visible := true;

      end;
  end;

  dxg.KeyField := cds.Fields.Fields[0].FieldName;
  dxg.FixedBandLineColor:=clBlue;
  dxg.OptionsDB:=dxg.OptionsDB + [edgoLoadAllRecords,edgoSmartrefresh,edgoSmartReload];
  dxg.OptionsBehavior:=dxg.OptionsBehavior + [edgoMultiSelect];
  dxg.ShowGroupPanel:=false;
  dxg.ShowSummaryFooter:=false;

  cds.first;
  dxg.FullRefresh;
  result := 0;
end;

function Tfrmmain.func_addFieldToDmd(dmdData: TdxMemData; ftType: TFieldType; sFieldName, sDisplayLabel: string;
  iSize: integer; iDisplayWidth: integer = 0): integer;
var
  AField : TField;
begin
  AField := DefaultFieldClasses[ftType].Create(nil);
  AField.Name := dmdData.Name + sFieldName;
  AField.FieldName := sFieldName;
  AField.Size := iSize;
  AField.DisplayLabel := sDisplayLabel;
  AField.DisplayWidth := 10;
  AField.DataSet := dmdData;
  result := 0;
end;

procedure Tfrmmain.CreatetabSheet(ACaption: String);
var
  AdxTabSheet: TdxTabSheet;
begin
  AdxTabSheet := TdxTabSheet.Create(self);
  AdxTabSheet.PageControl := dxpage;
  AdxTabSheet.Caption := ACaption;
  AdxTabSheet.ImageIndex := AdxTabSheet.PageControl.PageCount - 1;
  CreateEdit(AdxTabSheet, ACaption);
end;

procedure Tfrmmain.DestroytabSheet(index: integer);
var
i:integer;
begin
  try
  for i:=0 to dxpage.PageCount-1 do begin
    if dxpage.Pages[i].Caption=inttostr(index) then begin
      dxpage.Pages[i].Destroy;
    end;
  end;
  except
  //
  end;
end;

procedure Tfrmmain.CreateEdit(AParent: TWinControl; ACaption: String);
var
  AGrid:Tdxdbgrid;
begin
  AGrid:=Tdxdbgrid.Create(self);
  AGrid.Name:='DBG_'+trim(ACaption);
  AGrid.Parent:=aParent;
  AGrid.Align:=alClient;
end;

procedure Tfrmmain.CreateDmd(ACaption: String);
var
  Admd:Tdxmemdata;
  ADs:TDataSource;
begin
  Admd:=tdxmemdata.Create(self);
  Admd.Name:='DMD_'+trim(ACaption);
  ADs:=TDataSource.Create(self);
  ADs.Name:='DS_'+trim(ACaption);
end;

procedure Tfrmmain.btnQuitClick(Sender: TObject);
begin
  close;
end;

procedure Tfrmmain.btnExportWordClick(Sender: TObject);
var
sSaveFileName, sPath:string;
i:integer;
begin
  if SelectDirectory('请选择文件存放目录', '', sPath) then begin
    sPath:=DirToPath(sPath);
  end;
  for i:=0 to self.ComponentCount-1 do begin
    if (self.Components[i] is Tdxdbgrid) then begin
      if (self.Components[i] as Tdxdbgrid).DataSource.DataSet.RecordCount=0 then exit;
      gw:=TGridToWord.Create(self);
      gw.WordFileName:=sPath+self.Components[i].Name;
      gw.Grid:=(self.Components[i] as Tdxdbgrid);
      gw.autoexit:=true;
      gw.AutoSize:=true;
      gw.ShowProgress:=true;
      gw.SaveFormat:=TSaveFormat(GetEnumValue(TypeInfo(TSaveFormat),cbSaveFormat.Text));
      gw.TableFormat.Style:=TTableFormatStyle(GetEnumValue(TypeInfo(TTableFormatStyle),cbStyle.Text));
      gw.ExportToWord;
      gw.Free;
    end;
  end;
end;

function Tfrmmain.DirToPath(Dir: string): string;
var
  i: Integer;
begin
  i := Length(Dir);
  if i = 0 then
    Exit;
  if Dir[i] <> '\' then
    Result := Dir + '\'
  else
    Result := Dir;
end;

procedure Tfrmmain.init;
var
i:integer;
begin
  for i:=0 to dxpage.PageCount-1 do begin
    TdxMemdata(FindComponent('DMD_'+dxpage.Pages[i].Caption)).free;
    Tdxdbgrid(FindComponent('DBG_'+dxpage.Pages[i].Caption)).free;
    Tdatasource(FindComponent('DS_'+dxpage.Pages[i].Caption)).free;
  end;
  for i:=0 to dxpage.PageCount-1 do begin
    dxpage.Pages[0].Free;
  end;
end;

procedure Tfrmmain.FormShow(Sender: TObject);
var
ti: PTypeInfo;
td: PTypeData;
i: Integer;
begin
ti := TypeInfo(TSaveFormat);
td := GetTypeData(ti);
for i := td^.MinValue to td^.MaxValue do
  cbSaveFormat.Items.Add(GetEnumName(ti, i));

cbSaveFormat.ItemIndex:=0;

ti := TypeInfo(TTableFormatStyle);
td := GetTypeData(ti);
for i := td^.MinValue to td^.MaxValue do
  cbstyle.Items.Add(GetEnumName(ti, i));

cbstyle.ItemIndex:=0;

end;

end.