/// LastLineIsSeparate最后一行單獨成行
/// LeftOffset,TopOffset是Excel表的位置偏移
/// Delphi2007
procedure 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;
uj5u.com熱心網友回復：
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;
uj5u.com熱心網友回復：
不錯，感謝樓主轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/9614.html
標籤：非技術區