CSDN博客

img WindowsAPI

将TDBGridEh中的数据导出到Excel中

发表于2003/6/16 15:56:00  1495人阅读

分类: Delphi技术

procedure BatchDBGridEhDataToExcel(DBGrid:TDBGridEh;Title:string;DrawGridLine:Boolean;
  RangeFields:TStringList);

      该过程将TDBGridEh中的数据导出到Excel中。本过程能够将TDBGridEh的多层表头导出到Excel中,并且还能够将给定字段的相同的值合并一起,例如:

 

参数:

      DBGrid:TDBGridEh为要导出数据的网格控件,Title为报表的标题,DrawGridLine控制是否绘制网格线,RangeFields为需要合并数据的字段列表。

 

在“打印”按钮的OnClick事件中填写如下代码:

var
  RangeFields:TStringList;
begin
  file://true为绘制网格线//
  RangeFields:=TStringList.Create;
  RangeFields.Add('TJDWMC');
  try
    if RadioButton1.Checked then
      BatchDBGridEhDataToExcel(DBGrid_JTGS,Caption,true,RangeFields)
    else
      BatchDBGridEhDataToExcel(DBGrid_LYJ,Caption,true,RangeFields);
  finally
    RangeFields.Free;
  end;
end;


执行后启动Excel程序,显示界面如下所示:

注意:在合并网格时会出现是“否合并网格”对话框,请电击“是”即可。

需要声明的常量

const
  file://Excel用到的常量//
  xlHairline = $00000001;
  xlMedium = $FFFFEFD6;
  xlThick = $00000004;
  xlThin = $00000002;
const
  file://Excel用到的常量//
  xlContinuous = $00000001;
  xlDash = $FFFFEFED;
  xlDashDot = $00000004;
  xlDashDotDot = $00000005;
  xlDot = $FFFFEFEA;
  xlDouble = $FFFFEFE9;
  xlSlantDashDot = $0000000D;
  xlLineStyleNone = $FFFFEFD2;
const
  xlAll = $FFFFEFF8;
  xlAutomatic = $FFFFEFF7;
  xlBoth = $00000001;
  xlCenter = $FFFFEFF4;
  xlChecker = $00000009;
  xlCircle = $00000008;
  xlCorner = $00000002;
  xlCrissCross = $00000010;
  xlCross = $00000004;
  xlDiamond = $00000002;
  xlDistributed = $FFFFEFEB;
  xlDoubleAccounting = $00000005;
  xlFixedValue = $00000001;
  xlFormats = $FFFFEFE6;
  xlGray16 = $00000011;
  xlGray8 = $00000012;
  xlGrid = $0000000F;
  xlHigh = $FFFFEFE1;
  xlInside = $00000002;
  xlJustify = $FFFFEFDE;
  xlLightDown = $0000000D;
  xlLightHorizontal = $0000000B;
  xlLightUp = $0000000E;
  xlLightVertical = $0000000C;
  xlLow = $FFFFEFDA;
  xlManual = $FFFFEFD9;
  xlMinusValues = $00000003;
  xlModule = $FFFFEFD3;
  xlNextToAxis = $00000004;
  xlNone = $FFFFEFD2;
  xlNotes = $FFFFEFD0;
  xlOff = $FFFFEFCE;
  xlOn = $00000001;
  xlPercent = $00000002;
  xlPlus = $00000009;
  xlPlusValues = $00000002;
  xlSemiGray75 = $0000000A;
  xlShowLabel = $00000004;
  xlShowLabelAndPercent = $00000005;
  xlShowPercent = $00000003;
  xlShowValue = $00000002;
  xlSimple = $FFFFEFC6;
  xlSingle = $00000002;
  xlSingleAccounting = $00000004;
  xlSolid = $00000001;
  xlSquare = $00000001;
  xlStar = $00000005;
  xlStError = $00000004;
  xlToolbarButton = $00000002;
  xlTriangle = $00000003;
  xlGray25 = $FFFFEFE4;
  xlGray50 = $FFFFEFE3;
  xlGray75 = $FFFFEFE2;
  xlBottom = $FFFFEFF5;
  xlLeft = $FFFFEFDD;
  xlRight = $FFFFEFC8;
  xlTop = $FFFFEFC0;
  xl3DBar = $FFFFEFFD;
  xl3DSurface = $FFFFEFF9;
  xlBar = $00000002;
  xlColumn = $00000003;
  xlCombination = $FFFFEFF1;
  xlCustom = $FFFFEFEE;
  xlDefaultAutoFormat = $FFFFFFFF;
  xlMaximum = $00000002;
  xlMinimum = $00000004;
  xlOpaque = $00000003;
  xlTransparent = $00000002;
  xlBidi = $FFFFEC78;
  xlLatin = $FFFFEC77;
  xlContext = $FFFFEC76;
  xlLTR = $FFFFEC75;
  xlRTL = $FFFFEC74;
  xlFullScript = $00000001;
  xlPartialScript = $00000002;
  xlMixedScript = $00000003;
  xlMixedAuthorizedScript = $00000004;
  xlVisualCursor = $00000002;
  xlLogicalCursor = $00000001;
  xlSystem = $00000001;
  xlPartial = $00000003;
  xlHindiNumerals = $00000003;
  xlBidiCalendar = $00000003;
  xlGregorian = $00000002;
  xlComplete = $00000004;
  xlScale = $00000003;
  xlClosed = $00000003;
  xlColor1 = $00000007;
  xlColor2 = $00000008;
  xlColor3 = $00000009;
  xlConstants = $00000002;
  xlContents = $00000002;
  xlBelow = $00000001;
  xlCascade = $00000007;
  xlCenterAcrossSelection = $00000007;
  xlChart4 = $00000002;
  xlChartSeries = $00000011;
  xlChartShort = $00000006;
  xlChartTitles = $00000012;
  xlClassic1 = $00000001;
  xlClassic2 = $00000002;
  xlClassic3 = $00000003;
  xl3DEffects1 = $0000000D;
  xl3DEffects2 = $0000000E;
  xlAbove = $00000000;
  xlAccounting1 = $00000004;
  xlAccounting2 = $00000005;
  xlAccounting3 = $00000006;
  xlAccounting4 = $00000011;
  xlAdd = $00000002;
  xlDebugCodePane = $0000000D;
  xlDesktop = $00000009;
  xlDirect = $00000001;
  xlDivide = $00000005;
  xlDoubleClosed = $00000005;
  xlDoubleOpen = $00000004;
  xlDoubleQuote = $00000001;
  xlEntireChart = $00000014;
  xlExcelMenus = $00000001;
  xlExtended = $00000003;
  xlFill = $00000005;
  xlFirst = $00000000;
  xlFloating = $00000005;
  xlFormula = $00000005;
  xlGeneral = $00000001;
  xlGridline = $00000016;
  xlIcons = $00000001;
  xlImmediatePane = $0000000C;
  xlInteger = $00000002;
  xlLast = $00000001;
  xlLastCell = $0000000B;
  xlList1 = $0000000A;
  xlList2 = $0000000B;
  xlList3 = $0000000C;
  xlLocalFormat1 = $0000000F;
  xlLocalFormat2 = $00000010;
  xlLong = $00000003;
  xlLotusHelp = $00000002;
  xlMacrosheetCell = $00000007;
  xlMixed = $00000002;
  xlMultiply = $00000004;
  xlNarrow = $00000001;
  xlNoDocuments = $00000003;
  xlOpen = $00000002;
  xlOutside = $00000003;
  xlReference = $00000004;
  xlSemiautomatic = $00000002;
  xlShort = $00000001;
  xlSingleQuote = $00000002;
  xlStrict = $00000002;
  xlSubtract = $00000003;
  xlTextBox = $00000010;
  xlTiled = $00000001;
  xlTitleBar = $00000008;
  xlToolbar = $00000001;
  xlVisible = $0000000C;
  xlWatchPane = $0000000B;
  xlWide = $00000003;
  xlWorkbookTab = $00000006;
  xlWorksheet4 = $00000001;
  xlWorksheetCell = $00000003;
  xlWorksheetShort = $00000005;
  xlAllExceptBorders = $00000006;
  xlLeftToRight = $00000002;
  xlTopToBottom = $00000001;
  xlVeryHidden = $00000002;
  xlDrawingObject = $0000000E;
const

{ The list of VtFont styles }

{ FontStyleConstants }

  VtFontStyleBold = 1;
  VtFontStyleItalic = 2;
  VtFontStyleOutline = 4;

{ The list of VtFont effects }

{ FontEffectsConstants }

  VtFontEffectStrikeThrough = 256;
  VtFontEffectUnderline = 512;

-------------------------------------------------------------------------------------------------------

procedure SetTitleInExcel(Sheet:OleVariant;
  FirstRow,FirstCol,LastRow,LastCol:integer;Title:string);
var
  RangeStr:string;
  Range:Variant;
begin
  Sheet.Activate;
  RangeStr:=GetRangStr(FirstRow,FirstCol,LastRow,LastCol);
  Range:=Sheet.Range[RangeStr];
  Range.Merge(true);
  Range.Font.Size:=14;
  Range.Font.Name:='黑体';
  Range.Font.FontStyle:=VtFontStyleBold;
  Range.HorizontalAlignment := xlCenter;
  Range.VerticalAlignment := xlCenter;
  Range.Value:=Title;
end;

function  GetRangStr(FirstRow,FirstCol,LastRow,LastCol:integer):string;
var
  iA,iB:integer;
begin
  result:='';
  if (FirstRow<1)or(LastRow<1)or(LastRow<1)or(LastCol<1) then
    Exit;

  iA:=FirstCol div 26;
  iB:=FirstCol mod 26;
  if iB=0 then
  begin
    iA:=iA-1;
    iB:=26;
  end;

  if iA=0 then
    result:=Chr(Ord('A')+iB-1)+IntToStr(FirstRow)+':'
  else
    result:=Chr(Ord('A')+iA-1)+Chr(Ord('A')+iB-1)+IntToStr(FirstRow)+':';

  iA:=LastCol div 26;
  iB:=LastCol mod 26;
  if iB=0 then
  begin
    iA:=iA-1;
    iB:=26;
  end;

  if iA=0 then
    result:=result+Chr(Ord('A')+iB-1)+IntToStr(LastRow)
  else
    result:=result+Chr(Ord('A')+iA-1)+Chr(Ord('A')+iB-1)+IntToStr(LastRow);
end;

procedure DrawGridInExcel(Sheet:OleVariant;
  FirstRow,FirstCol,LastRow,LastCol:integer);
var
  RangeStr:string;
  Range:Variant;
begin
  Sheet.Activate;
  RangeStr:=GetRangStr(FirstRow,FirstCol,LastRow,LastCol);
  Range:=Sheet.Range[RangeStr];
  Range.Columns.Interior.ColorIndex:=0;
  Range.Borders.LineStyle:=xlHairline;
  Range.Font.Size:=8;
  Range.Font.Name:='楷体_GB2312';
end;

procedure TransMuiltTitleStr(Text: string;List:TStrings);
var
  str:string;
  Index:integer;
begin
  str:=Text;
  List.Clear;
  Index:=Pos('|',str);
  while Index>0 do
  begin
    List.Add(Copy(str,1,Index-1));
    str:=Copy(str,Index+1,Length(str)-Index);
    Index:=Pos('|',str);
  end;
  if Index=0 then
    List.Add(str);
end;

Function My_DataSetToExcelSheet(DataSet:TDataSet;m_Fields:tstringlist;Sheet:OleVariant;
  RangeFields:TStrings;DrawGridLine:Boolean;var FirstRow,FirstCol:integer): Boolean;
var
  DataFirstRow,Row,Col,i,j :Integer;
  BK:TBookMark;
  LastValue,CurrentValue:string;
  RangeStr:string;
  Range:Variant;
  RangeFirstRow,RangeFirstCol:integer;
  List:TStringList; file://用于存储复合标题各个行的字符串列表//
  MaxTVCount:integer;//标题最大纵向行数//
begin
  Result := False;
  if not Dataset.Active then exit;
  BK:=DataSet.GetBookMark;
  DataSet.DisableControls;
  Sheet.Activate;
  try
    file://定制复杂列标题//
    MaxTVCount:=0;
    List:=TStringList.Create;
    try
      Col:=FirstCol;
      for i:=0 to m_Fields.Count-1 do
      begin
        Row:=FirstRow;

        TransMuiltTitleStr(DataSet.FieldByName(m_Fields.Strings[i]).DisplayLabel,List);
        if List.Count>MaxTVCount then
          MaxTVCount:=List.Count;

        for j:=0 to List.Count-1 do
        begin
          Sheet.Cells(Row,Col) :=List.Strings[j];
          Inc(Row);
        end;
       
        Inc(Col);
      end;
    finally
      List.Free;
    end;

    file://绘制网格//
    if DrawGridLine then
    begin
      DrawGridInExcel(Sheet,FirstRow,1,FirstRow+DataSet.RecordCount+MaxTVCount-1,
        m_Fields.Count);
    end;
    file://横向合并标题网格//
    for i:=FirstRow to FirstRow+MaxTVCount-1 do
    begin
      file://记录当前行//
      Row:=i;
      file://如果列数大于零则计算//
      if m_Fields.Count>0 then
      begin
        RangeFirstCol:=1;
        LastValue:=Sheet.Cells.Item[Row,RangeFirstCol];

        for j:=2 to m_Fields.Count do
        begin
          CurrentValue:=Sheet.Cells.Item[Row,j];
          if CurrentValue<>LastValue then
          begin
            file://合并单元格//
            if LastValue<>'' then
            begin
              RangeStr:=GetRangStr(Row,RangeFirstCol,Row,j-1);
              Range:=Sheet.Range[RangeStr];
              file://Range.Merge(false);
              Range.mergecells:=true;
              Range.WrapText:=true;
              Range.HorizontalAlignment := xlCenter;
              Range.VerticalAlignment := xlCenter;
              Range.Value:=LastValue;
            end;

            RangeFirstCol:=j;
            LastValue:=Sheet.Cells.Item[Row,RangeFirstCol];
          end;
        end;
        file://合并单元格//
        if LastValue<>'' then
        begin
          RangeStr:=GetRangStr(Row,RangeFirstCol,Row,m_Fields.Count);
          Range:=Sheet.Range[RangeStr];
//          Range.Merge(false);
          Range.mergecells:=true;
          Range.WrapText:=true;
          Range.HorizontalAlignment := xlCenter;
          Range.VerticalAlignment := xlCenter;
          Range.Value:=LastValue;
        end;

        RangeFirstCol:=m_Fields.Count+1;
        LastValue:=Sheet.Cells.Item[Row,RangeFirstCol];
      end;
    end;
    file://纵向合并标题网格,将纵向最后一个不为空值的格与其下面所有空格合并到一起//
    if MaxTVCount>1 then
      for i:=1 to m_Fields.Count do
        for j:=FirstRow+MaxTVCount-1 downto FirstRow do
        begin
          CurrentValue:=Sheet.Cells.Item[j,i];
          if CurrentValue<>'' then
          begin
            if j<>FirstRow+MaxTVCount-1 then
            begin
              file://合并单元格//
              RangeStr:=GetRangStr(j,i,FirstRow+MaxTVCount-1,i);
              Range:=Sheet.Range[RangeStr];
              Range.Merge(false);
              Range.WrapText:=true;
              Range.HorizontalAlignment := xlCenter;
              Range.VerticalAlignment := xlCenter;
              Range.Value:=CurrentValue;
            end;
            Break;
          end;
        end;

    file://数据的第一条的索引号//
    DataFirstRow:=FirstRow+MaxTVCount;

    Row:=DataFirstRow;

    file://填写表格内容//
    DataSet.First;
    while Not DataSet.Eof do
    begin
      Col:=1;

      for i:=0 to m_Fields.count-1 do
      begin
        Sheet.Cells(Row,Col):=DataSet.FieldByName(m_Fields.Strings[i]).AsString;
        Inc(Col);
      end;

      Row:=Row+1;

      DataSet.Next;
    end;

    if m_Fields.count>0 then
      Col:=Col-1;
     
    file://合并项目字段的值//
    for i:=0 to RangeFields.Count-1 do
    begin
      Col:=m_Fields.IndexOf(RangeFields.Strings[i])+1;
      if DataSet.RecordCount>0 then
      begin
        RangeFirstRow:=DataFirstRow;
        LastValue:=Sheet.Cells.Item[RangeFirstRow,Col];

        for j:=1 to DataSet.RecordCount-1 do
        begin
          CurrentValue:=Sheet.Cells.Item[DataFirstRow+j,Col];
          if CurrentValue<>LastValue then
          begin
            file://合并单元格//
            RangeStr:=GetRangStr(RangeFirstRow,Col,DataFirstRow+j-1,Col);
            Range:=Sheet.Range[RangeStr];
            Range.Merge(false);
            Range.WrapText:=true;
            Range.HorizontalAlignment := xlCenter;
            Range.VerticalAlignment := xlCenter;
            Range.Value:=LastValue;

            RangeFirstRow:=DataFirstRow+j;
            LastValue:=Sheet.Cells.Item[RangeFirstRow,Col];
          end;
        end;
        file://合并单元格//
        RangeStr:=GetRangStr(RangeFirstRow,Col,DataFirstRow+DataSet.RecordCount-1,Col);
        Range:=Sheet.Range[RangeStr];
        Range.Merge(false);
        Range.WrapText:=true;
        Range.HorizontalAlignment := xlCenter;
        Range.VerticalAlignment := xlCenter;
        Range.Value:=LastValue;

        RangeFirstRow:=DataFirstRow+DataSet.RecordCount;
        LastValue:=Sheet.Cells.Item[RangeFirstRow,Col];
      end;
    end;

    Result := True;
  finally
    DataSet.GotoBookMark(BK);
    DataSet.EnableControls;
  end;
end;

 

procedure BatchDBGridEhDataToExcel(DBGrid:TDBGridEh;Title:string;DrawGridLine:Boolean;
  RangeFields:TStringList);
var
  s:tstringlist;
  i:integer;
begin
  if not DBGrid.DataSource.DataSet.active then
  begin
    MessageDlg('主结果集没有打开!',mtWarning,[mbok],0);
    exit;
  end;
  s:=tstringlist.create;
  try
    for i:=0 to DBGrid.Columns.Count-1 do
    begin
      s.Add(DBGrid.Columns[i].FieldName);
      DBGrid.DataSource.DataSet.FieldByName(
        DBGrid.Columns[i].FieldName).DisplayLabel:=
        DBGrid.Columns[i].Title.Caption;
    end;
    My_DataSetToExcel(DBGrid.DataSource.DataSet,s,RangeFields,DrawGridLine,true,
      Title,'');
  finally
    s.free;
  end;
end;

阅读全文
0 0

相关文章推荐

img
取 消
img