高分求dbgrid导入,导出excel实例

Question

求一实例
1.从excel导入数据到DBgrid,在导入至sql数据库中
2.从DBgrid中导出数据至excel
先谢过!!!

Answer 1

补充一下
开发环境  D2007   DdelphiXE,两种开发环境那种都可以!

Answer 2

//导出EXCEL
procedure Tfrmsalarybaseinfor.btnsalarybaseClick(Sender: TObject);
var
  sqlstr:string;
  xlapp,workbook,sheet:variant;
  irow,i,num:word;
  date1:tdatetime;
  p,f:real;
  filename,str,start_gh,end_gh,depart,company:shortstring;
begin
  with dm do
  begin
    if aq_salarybase.Active=false then
    begin
      showmessage('没有数据可导出!');
      exit;
    end;
    if aq_salarybase.RecordCount=0 then
    begin
      showmessage('没有数据可导出!');
      exit;
    end;
    aq_salarybase.First;
  end;
  screen.Cursor:=crhourglass;
  try
    xlapp:=createoleobject('excel.application');
  except
    xlApp:=UnAssigned;
    screen.Cursor:=crdefault;
    showmessage('创建Excel实例失败,请重新安装Office 2000!');
    exit;
  end;
  try
    workbook:=xlapp.workbooks.add;
    //workbook:=CreateOleobject('Excel.Sheet');
    //xlapp.workbooks.open(filename);
    //xlapp.visible:=true;
    //exit;
  except
    xlapp.quit;
    xlapp:=unassigned;
    screen.Cursor:=crdefault;
    showmessage('打开Excel文档失败!');
    exit;
  end;
  try
    sheet:=workbook.worksheets.add;
    workbook.worksheets[1].name:='薪资条';
    sheet:=workbook.worksheets[1];
    str:='确认要汇出员基本薪资信息吗？';
    if messagedlg(str,mtconfirmation,[mbyes,mbno],mb_yesno)=mryes then
    begin
      i:=1;
      f:=1;
      irow:=1;
      num:=0;
      try
        with dm do
        begin
          sheet.cells[irow,1]:='序号';
          sheet.cells[irow,2]:='课别';
          sheet.cells[irow,3]:='工号';
          sheet.cells[irow,4]:='姓名';
          sheet.cells[irow,5]:='职务';
          sheet.cells[irow,6]:='等级';
          sheet.cells[irow,7]:='级别';
          sheet.cells[irow,8]:='底薪';
          sheet.cells[irow,9]:='职务津贴';
          sheet.cells[irow,10]:='全勤津贴';
          sheet.cells[irow,11]:='特殊津贴';
          sheet.cells[irow,12]:='进厂日期';
          irow:=2;
          aq_salarybase.First;
          while not aq_salarybase.Eof do
          begin
            sheet.cells[irow,1]:=irow-1;
            sheet.cells[irow,2]:=aq_salarybase.FieldByName('department').AsString;
            sheet.cells[irow,3]:=aq_salarybase.FieldByName('gh').AsString;
            sheet.cells[irow,4]:=aq_salarybase.FieldByName('name').AsString;
            sheet.cells[irow,5]:=aq_salarybase.FieldByName('duty').AsString;
            sheet.cells[irow,6]:=aq_salarybase.FieldByName('dutydeji').AsString;
            sheet.cells[irow,7]:=aq_salarybase.FieldByName('dutyrank').AsString;
            sheet.cells[irow,8]:=aq_salarybase.FieldByName('salary').AsString;
            sheet.cells[irow,9]:=aq_salarybase.FieldByName('dutyallowance').AsString;
            sheet.cells[irow,10]:=aq_salarybase.FieldByName('fullattend').AsString;
            sheet.cells[irow,11]:=aq_salarybase.FieldByName('specallowance').AsString;
            sheet.cells[irow,12]:=aq_salarybase.FieldByName('incomedate').AsString;
            aq_salarybase.Next;
            irow:=irow+1;
            inc(num);
            labpersum.Caption:=inttostr(num)+' 条';
            labpersum.Refresh;
          end;
        end;
        xlapp.visible:=true;
      except
        on E:exception do
        begin
          if not VarIsEmpty(XLApp) then
          begin
            xlapp.quit;
            Sheet:=Unassigned;
            workbook:=unassigned;
            xlApp:=Unassigned;
            screen.Cursor:=crdefault;
          end;
          showmessage(e.Message);
          exit;
        end;
      end;
    end
    else
      showmessage('你已取消了汇出员工基本薪资操作！');
  finally
    if not VarIsEmpty(XLApp) then
    begin
      //xlapp.displayalerts:=false;
      //xlapp.screenupdating:=true;
      xlapp.quit;
      Sheet:=Unassigned;
      workbook:=unassigned;
      xlApp:=Unassigned;
      screen.Cursor:=crdefault;
    end;
  end;
end;//汇入
procedure Tfrmsalarybaseinfor.btninputmealClick(Sender: TObject);
var
  sqlstr,sqlstr1:string;
  str,filename:shortstring;
  xlapp,sheet,workbook:variant;
  irow,i:word;
begin
  opendialog1.FileName:='';
  opendialog1.Title:='请选择汇入伙食费文件';
  opendialog1.Filter:='Excel文档(*.xls)|*.xls';
  if opendialog1.Execute then
     filename:=opendialog1.FileName;
  if trim(filename)='' then
  begin
    showmessage('对不起，你没有选择汇入文件不能汇入伙食费资料,请选择文件後继续!!!' );
    exit;
  end;
  screen.Cursor:=crhourglass;
  try
    xlapp:=createoleobject('excel.application');
  except
    xlApp:=UnAssigned;
    screen.Cursor:=crdefault;
    showmessage('创建Excel实例失败,请重新安装Office 2000!');
    exit;
  end;
  try
    xlapp.workbooks.open(filename);
  except
    xlapp.quit;
    xlapp:=unassigned;
    screen.Cursor:=crdefault;
    showmessage('打开Excel文档失败!');
    exit;
  end;
  try
    workbook:=xlapp.workbooks[1];
    sheet:=workbook.worksheets[1];
    irow:=2;
    i:=1;
    str:='确定要导入伙食费资料吗？';
    if messagedlg(str,mtconfirmation,[mbyes,mbno],mb_yesno)=mryes then
    begin
      with dm do
      begin
        try
          //adoconnect.BeginTrans;
          sqlstr1:='update T_personbase set mealexpense=0';
          aq_exesql(aq_pub_query2,sqlstr1);
          while trim(sheet.cells[irow,1])<>'' do
          begin
            application.ProcessMessages;
            if (trim(sheet.cells[irow,3])='') then
            begin
                showmessage('工号为'+trim(sheet.cells[irow,1])+'所在行有空值,请确认!!!');
                //adoconnect.RollbackTrans;
                if not VarIsEmpty(XLApp) then
                begin
                  xlapp.quit;
                  Sheet:=Unassigned;
                  workbook:=unassigned;
                  xlApp:=Unassigned;
                  screen.Cursor:=crdefault;
                end;
                exit;
            end;
            sqlstr:='select gh from T_personbase where gh='''+trim(sheet.cells[irow,1])+'''';
            aq_open(aq_pub_query1,sqlstr);
            if  aq_pub_query1.Eof  then
            begin
              showmessage('此员工'+trim(sheet.cells[irow,1])+'不存在。请记下工号，随後由手工更改!!!');
              //adoconnect.RollbackTrans;
              if not VarIsEmpty(XLApp) then
              begin
                xlapp.quit;
                Sheet:=Unassigned;
                workbook:=unassigned;
                xlApp:=Unassigned;
                screen.Cursor:=crdefault;
              end;
              exit;
            end;
            sqlstr1:='update T_personbase set mealexpense='+trim(sheet.cells[irow,3])+' where gh='''+trim(sheet.cells[irow,1])+'''';
            aq_exesql(aq_pub_query2,sqlstr1);
            labpersum.Caption:=inttostr(i)+' 笔 ';
            labpersum.Refresh;
            inc(irow);
            inc(i);
          end;
          //adoconnect.CommitTrans;
          showmessage('数据导入完毕!!!');
        except
          on e:exception do
          begin
          //adoconnect.RollbackTrans;
          if not VarIsEmpty(XLApp) then
            begin
              xlapp.quit;
              Sheet:=Unassigned;
              workbook:=unassigned;
              xlApp:=Unassigned;
              screen.Cursor:=crdefault;
            end;
            showmessage(e.Message);
          end;
        end;
      end;
    end
    else
    begin
      str:='你已取消导入伙食费资料操作!!!';
      showmessage(str);
    end;
  finally
    if not VarIsEmpty(XLApp) then
    begin
      //xlapp.displayalerts:=false;
      //xlapp.screenupdating:=true;
      xlapp.quit;
      Sheet:=Unassigned;
      workbook:=unassigned;
      xlApp:=Unassigned;
      screen.Cursor:=crdefault;
    end;
  end;
end;

Answer 3

从DBgrid中导出数据至excel
unit DBGrid2Excel;interfaceuses
  Windows, Variants, Classes, SysUtils, Forms, DB, DBGrids, ComObj;type
  TUpAniInfoProc = procedure (const sInfo: string;Position,FullNum: Integer) of object;  function DBGridToExcel(dgrSource: TDBGrid;
          UpAniInfo: TUpAniInfoProc = nil; SaveFile: String = 'XyBook1.xls'): Integer;
  function DataSetToExcel(DataSet: TDataSet;
          UpAniInfo: TUpAniInfoProc = nil; SaveFile: String = 'XyBook1.xls'): Integer;implementation
const
  MAX_SHEET_ROWS = 65536-1;  //Excel每Sheet最大行数
  MAX_VAR_ONCE   = 1000;     //一次导出的条数
function DBGridToExcel(dgrSource: TDBGrid; UpAniInfo: TUpAniInfoProc; SaveFile: String): Integer;
var          //从DBGrid导出到Excel(改进至可以导入几乎无限的数据)
  MyExcel, varCells: Variant;
  MySheet, MyCells, Cell1, Cell2, Range: OleVariant;
  iRow, iCol, iRealCol, iSheetIdx, iVarCount, iCurRow, iFieldCount: integer;
  CurPos: TBook;
  DataSet: TDataSet;
  sFieldName: string;
begin          //返回导出记录条数
  DataSet := dgrSource.DataSource.DataSet;  DataSet.DisableControls;
  CurPos  := DataSet.GetBook;
  DataSet.First;  MyExcel := CreateOleObject('Excel.Application');
  MyExcel.WorkBooks.Add;
  MyExcel.Visible := False;  if DataSet.RecordCount <= MAX_VAR_ONCE then
    iVarCount := DataSet.RecordCount
  else
    iVarCount := MAX_VAR_ONCE;  iFieldCount := dgrSource.Columns.Count;        //对DBGrid，只导出显示的列
  for iCol:=0 to dgrSource.Columns.Count-1 do
    if not dgrSource.Columns[iCol].Visible then  //可能有不显示的列
      Dec(iFieldCount);
  varCells  := VarArrayCreate([1,
                               iVarCount,
                               1,
                               iFieldCount], varVariant);
  iSheetIdx := 1;
  iRow      := 0;
  Result    := 0;
  while not DataSet.Eof do
  begin
    if (iRow = 0) or (iRow > MAX_SHEET_ROWS + 1) then
    begin          //新增一个Sheet
      if iSheetIdx <= MyExcel.WorkBooks[1].WorkSheets.Count then
        MySheet := MyExcel.WorkBooks[1].WorkSheets[iSheetIdx]
      else
        MySheet := MyExcel.WorkBooks[1].WorkSheets.Add(NULL, MySheet);//加在后面
      MyCells := MySheet.Cells;
      Inc(iSheetIdx);
      iRow := 1;      iRealCol := 0;
      for iCol := 1 to iFieldCount do
      begin
        MySheet.Cells[1, iCol].Font.Bold := True;
        {MySheet.Select;
        MySheet.Cells[iRow,iCol].Select;
        MyExcel.Selection.Font.Bold := true;}//这种方法也可(Sheet.Select不可少)
        while not dgrSource.Columns[iRealCol].Visible do
          Inc(iRealCol);          //跳过不可见的列
        MySheet.Cells[1, iCol] := dgrSource.Columns[iRealCol].Title.Caption;
        MySheet.Columns[iCol].ColumnWidth := //以下方法似乎算得还行
          Integer(Round(dgrSource.Columns[iRealCol].Width * 2
          / abs(dgrSource.Font.Height)));
        sFieldName := dgrSource.Columns[iRealCol].FieldName;
        if (DataSet.FieldByName(sFieldName).DataType = ftString)
          or (DataSet.FieldByName(sFieldName).DataType = ftWideString) then
        begin          //对于“字符串”型数据则设Excel单元格为“文本”型
          MySheet.Columns[iCol].NumberFormatLocal := '@';
        end;
        Inc(iRealCol);
      end;
      Inc(iRow);
    end;
    iCurRow := 1;
    while not DataSet.Eof do
    begin
      iRealCol := 0;
      for iCol := 1 to iFieldCount do
      begin
        while not dgrSource.Columns[iRealCol].Visible do
          Inc(iRealCol);          //跳过不可见的列
        sFieldName := dgrSource.Columns[iRealCol].FieldName;
        varCells[iCurRow, iCol] := DataSet.FieldByName(sFieldName).AsString;
        Inc(iRealCol);
      end;
      Inc(iRow);
      Inc(iCurRow);
      Inc(Result);
      DataSet.Next;
      if (iCurRow > iVarCount) or (iRow > MAX_SHEET_ROWS + 1) then
      begin
        if Assigned(UpAniInfo) then
          UpAniInfo(Format('(已导出%d条,共%d条)', [Result, DataSet.RecordCount]),Result, DataSet.RecordCount); //显示已导出条数
        Application.ProcessMessages;
        Break;
      end;
    end;
    Cell1 := MyCells.Item[iRow - iCurRow + 1, 1];
    Cell2 := MyCells.Item[iRow - 1,
          iFieldCount];
    Range := MySheet.Range[Cell1 ,Cell2];
    Range.Value := varCells;
    if (iRow > MAX_SHEET_ROWS + 1) then     //一个Sheet导出结束
    begin
      MySheet.Select;
      MySheet.Cells[1, 1].Select;    //使得每一Sheet均定位在第一格
    end;
    Cell1    := Unassigned;
    Cell2    := Unassigned;
    Range    := Unassigned;  end;  MyCells  := Unassigned;
  varCells := Unassigned;
  MyExcel.WorkBooks[1].WorkSheets[1].Select;   //必须先选Sheet
  MyExcel.WorkBooks[1].WorkSheets[1].Cells[1,1].Select;
  MyExcel.Visible := False;
//  MyExcel.WorkBooks[1].Saved := True;
  MyExcel.DisplayAlerts:= False;
  MyExcel.WorkBooks[1].SaveAs(SaveFile);
//  MyExcel.WorkBooks[1].SaveCopyAs(SaveFile);
////  调用Excel另存新档功能
////  MyExcel.Application.CommandBars.FindControl(ID:=748).Execute;
  MyExcel.Quit;
  MyExcel:= Unassigned;
  if CurPos <> nil then
  begin
    DataSet.GotoBook(CurPos);
    DataSet.FreeBook(CurPos);
  end;
  DataSet.EnableControls;
end;end.

Answer 4

我有个delphi7的导出导入实例，如想要，写上你的邮箱

Answer 5

给俺也发份啊 
[email protected]
谢谢啦

Answer 6

同求 [email protected] 这个问题困扰我很久了 多谢

Answer 7

[email protected]
俺也要, 正在搜着导入这方面的资料呢, 太需要了 谢谢