求代码

Question

谁能发给我一份能选择导出EXCEL和打印的源码?用FR或者别的东西? [email protected]

Answer 1

unit DBGrid2Excel;interfaceuses
  Windows, Variants, Classes, SysUtils, Forms, DB, DBGrids, ComObj;type
  TUpAniInfoProc = procedure (const sInfo: string) of object;
{
procedure TForm1.UpdateAniInfo(const sInfo: string);
begin          //更新动画提示信息
  LabelWaitInfo.Caption := sInfo;
  PanelWaiting.Update();
end;
}
  function DBGridToExcel(dgrSource: TDBGrid;
          UpAniInfo: TUpAniInfoProc = nil): Integer;
  function DataSetToExcel(DataSet: TDataSet;
          UpAniInfo: TUpAniInfoProc = nil): Integer;
implementationconst
  MAX_SHEET_ROWS = 65536-1;  //Excel每Sheet最大行数
  MAX_VAR_ONCE   = 1000;     //一次导出的条数
function DBGridToExcel(dgrSource: TDBGrid; UpAniInfo: TUpAniInfoProc): Integer;
var          //从DBGrid导出到Excel(2005.8.23改进至可以导入几乎无限的数据)
  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  //可能有不显示的列 2005.9.10
      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);          //跳过不可见的列 2005.9.10
        MySheet.Cells[1, iCol] := dgrSource.Columns[iRealCol].Title.Caption;
        MySheet.Columns[iCol].ColumnWidth := //2005.9.9 以下方法似乎算得还行
          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);          //跳过不可见的列 2005.9.10
        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条)', [Result])); //显示已导出条数
        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  2005.8.23
  MyExcel.WorkBooks[1].WorkSheets[1].Cells[1,1].Select;
  MyExcel.Visible := True;
  MyExcel.WorkBooks[1].Saved := True;
  MyExcel  := Unassigned;
  if CurPos <> nil then
  begin
    DataSet.GotoBook(CurPos);
    DataSet.FreeBook(CurPos);
  end;
  DataSet.EnableControls;
end;

Answer 2

function DataSetToExcel(DataSet: TDataSet; UpAniInfo: TUpAniInfoProc): Integer;
var          //从DataSet导出到Excel(2005.8.23改进至可以导入几乎无限的数据)
  MyExcel, varCells: Variant;
  MySheet, MyCells, Cell1, Cell2, Range: OleVariant;
  iRow, iCol, iSheetIdx, iVarCount, iCurRow: integer;
  CurPos: TBook;
begin          //返回导出记录条数
  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;
  varCells  := VarArrayCreate([1,
          iVarCount,
          1,
          DataSet.FieldCount], 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;      for iCol := 1 to DataSet.FieldCount do
      begin
        MySheet.Cells[1, iCol].Font.Bold := True;
        {MySheet.Select;
        MySheet.Cells[iRow,iCol].Select;
        MyExcel.Selection.Font.Bold := true;}//这种方法也可(Sheet.Select不可少)
        MySheet.Cells[1, iCol] := DataSet.Fields[iCol-1].DisplayName;
        MySheet.Columns[iCol].ColumnWidth :=DataSet.Fields[iCol-1].DisplayWidth;
        if (DataSet.Fields[iCol - 1].DataType = ftString)
          or (DataSet.Fields[iCol - 1].DataType = ftWideString) then
        begin          //对于“字符串”型数据则设Excel单元格为“文本”型
          MySheet.Columns[iCol].NumberFormatLocal := '@';
        end;
      end;
      Inc(iRow);
    end;
    iCurRow := 1;
    while not DataSet.Eof do
    begin
      for iCol := 1 to DataSet.FieldCount do
      begin
        varCells[iCurRow, iCol] := DataSet.Fields[iCol-1].AsString;
      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条)', [Result])); //显示已导出条数
        Application.ProcessMessages;
        Break;
      end;
    end;
    Cell1 := MyCells.Item[iRow - iCurRow + 1, 1];
    Cell2 := MyCells.Item[iRow - 1,
          DataSet.FieldCount];
    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  2005.8.23
  MyExcel.WorkBooks[1].WorkSheets[1].Cells[1,1].Select;
  MyExcel.Visible := True;
  MyExcel.WorkBooks[1].Saved := True;
  MyExcel  := Unassigned;
  if CurPos <> nil then
  begin
    DataSet.GotoBook(CurPos);
    DataSet.FreeBook(CurPos);
  end;
  DataSet.EnableControls;
end;end.