unit1.~pas

导入导出Excel的源码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    grdlist: TDBGrid;
    btn: TBitBtn;
    btnin: TBitBtn;
    ADOConnection1: TADOConnection;
    DataSource1: TDataSource;
    OpenDialog1: TOpenDialog;
    ADOQuery1: TADOQuery;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure btnClick(Sender: TObject);
    procedure btninClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnClick(Sender: TObject);
begin
  OpenDialog1.Title := '请选择相应的Excel文件';
  OpenDialog1.Filter := 'Excel(*.xls)|*.xls';
  if OpenDialog1.Execute then
    edit1.Text := OpenDialog1.FileName;
end;


procedure TForm1.btninClick(Sender: TObject);
const
    BeginRow = 3; BeginCol = 1;
var
    Excel: OleVariant;
    iRow,iCol : integer;
    xlsFilename: string;
begin
if (trim(edit1.Text) = '') then
  begin
    MessageBox(GetActiveWindow(), '请正确选择相关路径！', '警告', MB_OK +
      MB_ICONWARNING);
    exit;
  end;
  xlsFilename := trim(edit1.Text);
    try
        Excel := CreateOLEObject('Excel.Application');
    except
        Application.MessageBox('Excel没有安装！', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
        Exit;
    end;
    Excel.Visible := false;
    Excel.WorkBooks.Open(xlsFilename);
    try
        iRow := BeginRow;
        iCol := BeginCol;
        while trim(Excel.WorkSheets[2].Cells[iRow,iCol].value) <> '' do begin
            with ADOQuery1 do begin
                Append;
                Fields[0].AsString := trim(Excel.WorkSheets[2].Cells[iRow,iCol].value);
                Fields[1].AsString := trim(Excel.WorkSheets[2].Cells[iRow,iCol+1].value);
                Fields[2].Asstring := trim(Excel.WorkSheets[2].Cells[iRow,iCol+2].value);
                Fields[3].Asstring := trim(Excel.WorkSheets[2].Cells[iRow,iCol+3].value);
                Fields[4].AsString := trim(Excel.WorkSheets[2].Cells[iRow,iCol+4].value);
                iRow := iRow + 1;
            end;
   end;
        Excel.Quit;
        ADOQuery1.UpdateStatus ;
    except
        Application.MessageBox('导入数据出错！请检查文件的格式是否正确！', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
        Excel.Quit;
    end;
   MessageBox(GetActiveWindow(), '数据导入成功!', '警告', MB_OK +
        MB_ICONWARNING);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var  h,k:integer;
     Excelid: OleVariant;
     s: string;
begin
     try
        Excelid := CreateOLEObject('Excel.Application');
    except
        Application.MessageBox('Excel没有安装！', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
        Exit;
    end;
       try
        ADOQuery1.Close;
        ADOQuery1.SQL.Clear;
        ADOQuery1.SQL.Add('select * from tsource');
        ADOQuery1.Open;
        k:=ADOQuery1.RecordCount;
         Excelid.Visible := True;
         Excelid.WorkBooks.Add;
         Excelid.worksheets[1].range['A1:e1'].Merge(True);
         Excelid.WorkSheets[1].Cells[1,1].Value :='招待费用支出情况表' ;
         Excelid.WorkSheets[1].Cells[2,1].Value := '时间';
         Excelid.WorkSheets[1].Cells[2,2].Value := '对象';
         Excelid.WorkSheets[1].Cells[2,3].Value := '人数';
         Excelid.WorkSheets[1].Cells[2,4].Value := '金额';
         Excelid.WorkSheets[1].Cells[2,5].Value := '经办';
         Excelid.WorkSheets[1].Cells[2,6].Value := '备注';
         Excelid.worksheets[1].Range['A1:f1'].Font.Name := '宋体';
         Excelid.worksheets[1].Range['A1:f1'].Font.Size := 14;
         Excelid.worksheets[1].range['A1:f2'].font.bold:=true;
         Excelid.worksheets[1].Range['A2:f2'].Font.Size := 10;
         h:=3;
         ADOQuery1.First;
        while not ADOQuery1.Eof do
         begin
           Excelid.WorkSheets[1].Cells[h,1].Value := Adoquery1.FieldByName('招待时间').AsString;
           Excelid.WorkSheets[1].Cells[h,2].Value := Adoquery1.FieldByName('对象').AsString;
           Excelid.WorkSheets[1].Cells[h,3].Value := Adoquery1.FieldByName('人数').AsString;
           Excelid.WorkSheets[1].Cells[h,4].Value := Adoquery1.FieldByName('金额').AsString;
           Excelid.WorkSheets[1].Cells[h,5].Value := Adoquery1.FieldByName('经办').AsString;
           Inc(h);
            Adoquery1.Next;
         end;
         s := 'A2:f'+ IntToStr(k+2);
         Excelid.worksheets[1].Range['a1:a1'].HorizontalAlignment := $FFFFEFF4;
         Excelid.worksheets[1].Range['a1:a1'].VerticalAlignment := $FFFFEFF4;
         Excelid.worksheets[1].Range[s].Font.Name := '宋体';
         Excelid.worksheets[1].Range[s].Borders.LineStyle := 1;
         Excelid.Quit;
          except
        Application.MessageBox('导入数据出错！请检查文件的格式是否正确！', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
    end;
   MessageBox(GetActiveWindow(), '数据导出成功!', '警告', MB_OK +
        MB_ICONWARNING);
end;

end.