uexportexcel.pas

本程序是在实施用友ERP时根据客户要求专门为用友U8开发的生产标准生产成本的二次开发程序。

unit uExportExcel;

interface

uses
    Classes,
    Dialogs,
    Db,
    ComObj,
    Forms,
    Controls,
    ComCtrls,
    Variants,
    SysUtils,
    ABSDlgWait;

procedure ToExcel(dsData: TDataSource);
procedure ExportToExcel(dsData: TDataSource; ShowDialog: boolean; StatusBar: TStatusBar);

const
    VAR_MAXROWS = 2147483646;

implementation

uses
    uFieldSelection;

procedure ExportToExcel(dsData: TDataSource; ShowDialog: boolean; StatusBar: TStatusBar);
var
    Ok: boolean;
    StopExportToExcel: boolean;
    MaxRows, HlpCnt: integer;
    fWait: TfrmWait;
const
    xlWBATWorksheet = -4167;

    procedure MakeSheet;
    var
        V: Variant;
        Cnt, FieldCnt, SheetColCnt, SheetRowCnt: Integer;
        Sheet: Variant;
        HlpStr: string;
        BakDecimalSeparator: Char;
    begin
        if not VarIsEmpty(V) then
            VarClear(V);
        V := CreateOleObject('Excel.Application');
        BakDecimalSeparator := DecimalSeparator;
        DecimalSeparator := '.'; // SQL requires '.' as a decimal separator
        try
            V.Workbooks.Add(xlWBATWorksheet);
            V.WorkBooks[1].Worksheets[1].Name := '标准生产成本';
            Sheet := V.WorkBooks[1].Worksheets['标准生产成本'];

            FieldCnt := 0;
            SheetColCnt := 1;
            SheetRowCnt := 1;
            for Cnt := 0 to dsData.DataSet.Fields.Count - 1 do
            begin
                if (dsData.DataSet.Fields[Cnt].Visible) then
                begin
                    if (frmFieldSelection.FieldList.Checked[FieldCnt]) then
                        with dsData.DataSet.Fields[Cnt] do
                        begin
                            Sheet.Cells[SheetRowCnt, SheetColCnt] := DisplayName;
                            Sheet.Cells[SheetRowCnt, SheetColCnt].Font.Bold := true;
                            if DisplayWidth <= 50 then
                                Sheet.Columns.Columns[SheetColCnt].ColumnWidth := DisplayWidth + 2
                            else
                                Sheet.Columns.Columns[SheetColCnt].ColumnWidth := 50;
                            Sheet.Columns.Columns[SheetColCnt].Font.Name := 'Arial';
                            Sheet.Columns.Columns[SheetColCnt].Font.Size := 10;

                            if (dsData.DataSet.Fields[Cnt].DataType in [ftFloat, ftDate, ftDateTime]) then
                                Sheet.Cells[SheetRowCnt, SheetColCnt].HorizontalAlignment := -4152;

                            Inc(SheetColCnt);
                        end;
                    Inc(FieldCnt);
                end;
            end;

            with dsData.DataSet do
            begin
                dsData.DataSet.first;
                while not (dsData.DataSet.eof) and (SheetRowCnt <= MaxRows) do
                begin
                    FieldCnt := 0;
                    SheetColCnt := 1;
                    inc(SheetRowCnt);
                    for Cnt := 0 to FieldCount - 1 do
                    begin
                        if dsData.DataSet.Fields[Cnt].Visible then
                        begin
                            if (frmFieldSelection.FieldList.Checked[FieldCnt]) then
                            begin
                                if Fields[Cnt].DataType in [ftDate, ftDateTime] then
                                begin
                                    if not (Fields[Cnt].IsNull) then
                                        Sheet.Cells[SheetRowCnt, SheetColCnt] :=
                                            FormatDateTime('mm-dd-yyyy', Fields[Cnt].asDateTime)
                                    else
                                        Sheet.Cells[SheetRowCnt, SheetColCnt] := '';
                                end
                                else
                                begin
                                    HlpStr := Fields[Cnt].asString;

                                    if Fields[Cnt].DataType in [ftString, ftMemo] then
                                        HlpStr := '''' + Hlpstr;

                                    if (dsData.DataSet.Fields[Cnt].DataType = ftFloat) then
                                        HlpStr := StringReplace(HlpStr, ',', '.', [rfIgnoreCase, rfReplaceAll]);

                                    Sheet.Cells[SheetRowCnt, SheetColCnt] := HlpStr;
                                end;
                                Inc(SheetColCnt);
                            end;
                            Inc(FieldCnt);
                        end;
                    end;

                    Next;

                    fWait.pb.Position := fWait.pb.Position + 1;
                    if (SheetRowCnt - 1) mod 100 = 0 then
                    begin
                        Application.ProcessMessages;
                        if fWait.Terminated then
                            break;
                        if (StatusBar <> nil) then
                        begin
                            StatusBar.SimpleText := ' 导出记录 : ' + IntToStr(SheetRowCnt - 1);
                        end;
                    end;

                    if StopExportToExcel then
                        break;
                end;
            end;
            if (StatusBar <> nil) then
            begin
                StatusBar.SimpleText := ' 成功导出 ' + IntToStr(SheetRowCnt - 1) + ' 条记录到Excel';
            end;

        finally
            DecimalSeparator := BakDecimalSeparator;
            V.Visible := true; { Show Excel result }
        end;
    end;

begin
    if not (dsData.DataSet.Active) then
        dsData.DataSet.Open;

    Ok := true;
    Application.CreateForm(TfrmFieldSelection, frmFieldSelection);

    frmFieldSelection.ExportLimitCB.ItemIndex := 0;
    frmFieldSelection.FieldList.Items.Clear;

    for HlpCnt := 0 to dsData.DataSet.Fields.Count - 1 do
    begin {Vul alle velden afhankelijk van de waarde}
        if dsData.DataSet.Fields[HlpCnt].Visible then
        begin
            frmFieldSelection.FieldList.Items.Add(dsData.DataSet.Fields[HlpCnt].DisplayName);
            frmFieldSelection.FieldList.Checked[frmFieldSelection.FieldList.Items.Count - 1] := true;
        end;
    end;

    if ShowDialog then
    begin
        Ok := (frmFieldSelection.ShowModal = mrOK);
    end;

    MaxRows := VAR_MAXROWS;
    if (trim(uppercase(frmFieldSelection.ExportLimitCB.Text)) <> 'ALL') then
    begin
        try
            try
                MaxRows := StrToInt(trim(uppercase(frmFieldSelection.ExportLimitCB.Text)));
            except
                ShowMessage('You specified an invalid number of records to export!');
                Ok := False;
            end;
        finally
        end;
    end;

    StopExportToExcel := false;

    if not dsData.Dataset.Active then
        Exit;

    if ok then
    begin
        try
            Screen.Cursor := crHourGlass;
            dsData.DataSet.DisableControls;

            fWait := TfrmWait.Create(nil);
            fWait.btnBgMode.Visible := False;
            fWait.pb.Max := dsData.DataSet.RecordCount;
            fWait.Show('导出数据到 Excel');
            Application.ProcessMessages;
            fWait.ShowFormOnTimer(nil);

            MakeSheet;
        finally
            fWait.Close;
            fWait.Free;

            dsData.DataSet.EnableControls;
            dsData.DataSet.First;
            Screen.Cursor := crDefault;
        end;
    end;
    frmFieldSelection.Free;
end;

procedure ToExcel(dsData: TDataSource);
begin
    ExportToExcel(dsData, False, nil);
end;

//------------------------------- eof ------------------------------------------

end.