分享, DBGridEh输出多层表头至Excel, 递归实现。

Question

/// LastLineIsSeparate最后一行单独成行
/// LeftOffset,TopOffset是Excel表的位置偏移
/// Delphi2007procedure DBGridEhToExcelEx(DBGridEh: TDBGridEh; LastLineIsSeparate: boolean;
    LeftOffset: integer; TopOffset: integer);
var
    XLApp: variant;
    sheet: variant;
    ARange: variant;    TitleList: TList;
    MaxDepth: integer;    /// left 是Title的索引 从0开始
    /// top 是Title.List[x]的索引 从0开始    procedure DrawSheetHead(Left, Top, Width: integer);
    var
        i: integer;
        str: string;
        tmpWidth: integer;
        Row, Col: integer;
        Cell1, Cell2: variant;
        RightMost: integer; //最右边列的位置 自0开始
    begin
        RightMost := Left + Width - 1;        while Left <= RightMost do
        begin
            if (TStringList(TitleList.List[Left]).Count <= 0)
                or (Top = TStringList(TitleList.List[Left]).Count) then
            begin
                ///用于最后一个title.caption单独成一行情况
                ///    这时可能会有部分stringlist.count = 0
                ///或 TitleList已输出最后一个caption                tmpWidth := 1;                Row := Top + 1 + TopOffset;
                Col := Left + 1 + LeftOffset;
                Cell1 := XLApp.Cells.Item[Row, Col];                Row := Top + 1 + TopOffset + MaxDepth - TStringList(TitleList.List[Left]).count;
                col := Left + 1 + LeftOffset;
                Cell2 := XLApp.Cells.Item[row, col];                ARange := Sheet.Range[Cell1, Cell2];
                ARange.Merge;
                ARange.horizontalalignment := xlCenter;
            end
            else
            begin
                if Top < TStringList(TitleList.List[Left]).Count - 1 then
                begin
                    tmpWidth := 1;                    str := TStringList(TitleList.List[Left]).Strings[Top];                    for i := 1 to Width - 1 do
                    begin
                        if ((Left + i) > RightMost)
                            or (Top >= TStringList(TitleList.List[Left + i]).Count) then
                            break;                        if str = TStringList(TitleList.List[Left + i]).Strings[Top] then
                            Inc(tmpWidth)
                        else
                            break;
                    end;                    Row := Top + 1 + TopOffset;
                    Col := Left + 1 + LeftOffset;
                    Cell1 := XLApp.Cells.Item[Row, Col];                    Row := Top + 1 + TopOffset;
                    Col := Left + LeftOffset + tmpWidth;
                    Cell2 := XLApp.Cells.Item[Row, Col];
                    ARange := Sheet.Range[Cell1, Cell2];
                    ARange.Merge;
                    ARange.Value := str;
                    ARange.horizontalalignment := xlCenter;                    DrawSheetHead(Left, Top + 1, tmpWidth);
                end
                else if (Top = TStringList(TitleList.List[Left]).Count - 1) then //最后一行
                begin
                    tmpWidth := 1;                    str := TStringList(TitleList.List[Left]).Strings[Top];                    for i := 1 to Width - 1 do
                    begin
                        if ((Left + i) > RightMost)
                            or (Top >= TStringList(TitleList.List[Left + i]).Count) then
                            break;                        if str = TStringList(TitleList.List[Left + i]).Strings[Top] then
                            Inc(tmpWidth)
                        else
                            break;
                    end;                    Row := Top + 1 + TopOffset;
                    Col := Left + 1 + LeftOffset;
                    Cell1 := XLApp.Cells.Item[Row, Col];                    Row := Top + 1 + TopOffset + MaxDepth - TStringList(TitleList.List[Left]).count;
                    Col := Left + LeftOffset + tmpWidth;
                    Cell2 := XLApp.Cells.Item[row, col];                    ARange := Sheet.Range[Cell1, Cell2];
                    ARange.Merge;
                    ARange.Value := str;
                    ARange.horizontalalignment := xlCenter;
                end;
            end;            Left := Left + tmpWidth;
        end;
    end;    function CreateTitleList(DBGridEh: TDBGridEh): TList;
    var
        i, position: integer;
        str: string;
        Offset: integer;    begin
        result := TList.Create;        //'|' 前后必须有其他字符串
        result.Count := DBGridEh.VisibleColumns.Count;
        for i := 0 to result.Count - 1 do
        begin
            result.List[i] := TStringList.Create;
            str := DBGridEh.VisibleColumns[i].Title.Caption;            offset := 1;            while true do
            begin
                position := PosEx('|', str, offset);
                if (position = 0) then
                begin
                    if (offset = 1) then
                    begin
                        TStringList(result.List[i]).add(str);
                        break;
                    end
                    else // offset > 1
                    begin
                        TStringList(result.List[i]).Add(copy(str, offset, length(str) - offset + 1));
                        break;
                    end;
                end
                else
                begin
                    TStringList(result.List[i]).Add(copy(str, offset, position - offset));
                    offset := position + 1;
                end;
            end;
        end;
    end;    procedure ExportData(DBGridEh: TDBGridEh; LeftOffset: integer; TopOffset: integer);
    var
        DataSet: TDataSet;
        RecordCount: integer;
        row, col: integer;    begin
        DataSet := DBGridEh.DataSource.DataSet;
        DataSet.DisableControls;        if LastLineIsSeparate then
            MaxDepth := MaxDepth + 1;        ///数据
        RecordCount := DataSet.RecordCount;
        DataSet.First;
        for row := 0 to RecordCount - 1 do
        begin
            ///ShowProgress(row + 1, RecordCount);            for col := 0 to DBGridEh.VisibleColumns.Count - 1 do
            begin
                Sheet.Cells[row + 1 + TopOffset + MaxDepth, Col + LeftOffset + 1]
                    := DBGridEh.VisibleColumns[col].DisplayText;
            end;            DataSet.Next;
        end;        DataSet.EnableControls;
    end;   ///简单设置显示格式
    procedure SetSheetDisplayFormat(Sheet: variant);
    begin
    end;var
    i: integer;
    depth: integer;begin
    XLApp := CreateOleObject('Excel.Application');
    //XLApp.Visible := true;
    XLApp.Workbooks.add;
    XLApp.WorkBooks[1].WorkSheets[1].Activate;
    XLApp.WorkBooks[1].WorkSheets[1].Name := 'MyExcelData';
    Sheet := XLApp.WorkBooks[1].WorkSheets['MyExcelData'];    TitleList := CreateTitleList(DBGridEh);    MaxDepth := 0;
    for i := 0 to TitleList.Count - 1 do
    begin
        if TStringList(TitleList.List[i]).Count > MaxDepth then
            MaxDepth := TStringList(TitleList.List[i]).Count;
    end;    try
        if LastLineIsSeparate then
        begin
        /// 先输出表头的最后一行
            for i := 0 to TitleList.Count - 1 do
            begin
                depth := TStringList(TitleList.List[i]).Count;
                Sheet.Cells[MaxDepth + TopOffset, i + 1 + LeftOffset]
                    := TStringList(TitleList.List[i]).Strings[depth - 1];
                Sheet.Cells[MaxDepth + TopOffset, i + 1 + LeftOffset].horizontalalignment := xlCenter;
                TStringList(TitleList.List[i]).Delete(depth - 1);
            end;
            MaxDepth := MaxDepth - 1;
        end;
        ///输出表头的其他部分
        DrawSheetHead(0, 0, TitleList.Count);
        //数据
        ExportData(DBGridEh, LeftOffset, TopOffset);
        //显示格式
        SetSheetDisplayFormat(Sheet);
    finally
    end;
end;

Answer 1

procedure SetSheetDisplayFormat(Sheet: variant);        procedure SetLineWeight(Line: variant; Weight: XlBorderWeight);
        begin
            Line.LineStyle := xlContinuous;
            Line.Weight := Weight;
            Line.ColorIndex := xlAutomatic;
        end;    var
        row, col: integer;
        DataTyp: TFieldType;
        DataSet: TDataSet;
        RecordCount: integer;    begin
        DataSet := DBGridEh.DataSource.DataSet;
        RecordCount := DataSet.RecordCount;        ////简单设置显示格式
        ////表头
        ARange := Sheet.Range[Sheet.Cells[TopOffset + 1, LeftOffset + 1],
            Sheet.Cells[TopOffset + MaxDepth, LeftOffset + DBGridEh.VisibleColumns.Count]];
        ARange.interior.colorindex := 8;
        SetLineWeight(ARange.Borders[xlInsideVertical], xlThin);
        SetLineWeight(ARange.Borders[xlInsideHorizontal], xlThin);
        SetLineWeight(ARange.Borders[xlEdgeBottom], xlThin);
        ///数据
        ARange := Sheet.Range[Sheet.Cells[TopOffset + 1 + Maxdepth, LeftOffset + 1],
            Sheet.Cells[TopOffset + MaxDepth + RecordCount, LeftOffset + DBGridEh.VisibleColumns.Count]];
        ARange.interior.colorindex := 19; //19
        SetLineWeight(ARange.Borders[xlInsideVertical], xlThin);
        SetLineWeight(ARange.Borders[xlInsideHorizontal], xlThin);        row := TopOffset + MaxDepth;        for col := 0 to DBGridEh.VisibleColumns.Count - 1 do
        begin
            DataTyp := DataSet.FieldByName(DBGridEh.VisibleColumns[col].Fieldname).DataType;
            ARange := Sheet.Range[Sheet.Cells[TopOffset + MaxDepth + 1, Col + 1 + LeftOffset],
                Sheet.Cells[row + RecordCount, Col + 1 + LeftOffset]];
            if DataTyp = ftDate then
                ARange.NumberFormatLocal := ' yyyy-mm-dd '
            else if DataTyp = ftFloat then
                Arange.NumberFormatLocal := '#,##0.00_ ;[红色]-#,##0.00 ';
            
        end;        ////边框
        ARange := Sheet.Range[Sheet.Cells[TopOffset + 1, LeftOffset + 1],
            Sheet.Cells[TopOffset + MaxDepth + RecordCount, LeftOffset + DBGridEh.VisibleColumns.Count]];        SetLineWeight(ARange.Borders[xlEdgeLeft], xlThick);
        SetLineWeight(ARange.Borders[xlEdgeTop], xlThick);
        SetLineWeight(ARange.Borders[xlEdgeBottom], xlThick);
        SetLineWeight(ARange.Borders[xlEdgeRight], xlThick);        Arange.columns.autofit;
        Arange.Rows.autofit;
    end;