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;
本文地址：http://com.8s8s.com/it/it5361.htm