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.GotoBookmark(CurPos); DataSet.FreeBookmark(CurPos); end; DataSet.EnableControls; end;
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不可少) if bIsDBGrid then //是DBGrid，则根据DBGrid设置标题行 begin MySheet.Cells[1, iCol] := dgrSource.Columns[iCol-1].Title.Caption; MySheet.Columns[iCol].ColumnWidth := //2005.9.9 以下方法似乎算得还行 Integer(Round(dgrSource.Columns[iCol-1].Width * 2 / abs(dgrSource.Font.Height))); end else //是DataSet，则根据DataSet设置标题行 begin MySheet.Cells[1, iCol] := DataSet.Fields[iCol-1].DisplayName; MySheet.Columns[iCol].ColumnWidth := DataSet.Fields[iCol-1].DisplayWidth; end; 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.GotoBookmark(CurPos); DataSet.FreeBookmark(CurPos); end; DataSet.EnableControls; end;
function DBGridToExcel(dgrSource: TDBGrid; UpAniInfo: TUpAniInfoProc): Integer; begin //从DBGrid导出到Excel(2005.8.23改进至可以导入几乎无限的数据) Result := ExportToExcel(dgrSource, nil, UpAniInfo); end;
function DataSetToExcel(DataSet: TDataSet; UpAniInfo: TUpAniInfoProc): Integer; begin //从DataSet导出到Excel(2005.8.23改进至可以导入几乎无限的数据) Result := ExportToExcel(nil, DataSet, UpAniInfo); end;
