stringgrid的数据快速导入到excel的问题(17分)

  • 主题发起人 主题发起人 bbcock
  • 开始时间 开始时间
B

bbcock

Unregistered / Unconfirmed
GUEST, unregistred user!
我用的如下代码导入excel,速度奇快,但有个问题,这段代码直接生成的excel文件,但我对excek表头,文字方向有要求,这可怎么办?

procedure TMainFrm.XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
const
{$J+}
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;

function TMainFrm.StringGridToExcel(AGrid: TStringGrid; AFileName: string): Boolean;
const
{$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
CXlsEof: array[0..1] of Word = ($0A, 00);
var
FStream: TFileStream;
I, J: Integer;
begin
Result := False;
FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
Result := True;
finally
FStream.Free;
end;
end;
 
参看如下码:
function DBGridExp_EXC_formate(DBGD:TDBgrid):boolean;
{将DBGD中数据导出成excel文件快速带格式-2003 by 白忙剩人}
var
i,hang,lie:integer;
datas:Variant;
PDBset:^TADODataSet;
st:string;
I_width:extended;
ExcelApp,MyWorkBook,EWorksheet:Variant;
c:Tcolor;
begin

result:=false;
st:=''; // clred
hang:=1;
lie:=0;
PDBset:=@DBGD.DataSource.DataSet;
if PDBset.RecordCount>65530 then
if messageDlg('数据行数可能超过EXCEL最大限制,是否改用文本导出,忽略限制按NO',
mtWarning ,[mbYes,mbNo], 0)=mrYes then exit;
//----------------------test start------
try
ExcelApp:=CreateOleObject('Excel.Application');
MyWorkBook:=CreateOleobject('Excel.Sheet');
except
on Exception do raise exception.Create('无法打开Xls文件,请确认已 经安装EXCEL')
end;
// ExcelApp.Visible := true;
MyworkBook:=ExcelApp.workBooks.Add;
// MyworkBook.Activate;
EWorksheet:=Myworkbook.worksheets[1];
// ---------------- test end----------

try


for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
begin
inc(lie);
ExcelApp.Range[EWorksheet.Cells[hang,lie],
EWorksheet.Cells[hang,lie]].Select;
c:=DBGD.Columns.Title.Color;
ExcelApp.Selection.Interior.Color:= ColorToRGB(c);
ExcelApp.Selection.HorizontalAlignment:=
GetExcelAlignment(DBGD.Columns.Title.Alignment);
ExcelApp.Selection.font.FontStyle:=
GetExcelFontStyle(DBGD.Columns.Title.Font.Style);
if fsUnderline in DBGD.Columns.Title.Font.Style then
ExcelApp.Selection.font.Underline := xlUnderlineStyleSingle
else ExcelApp.Selection.font.Underline :=xlUnderlineStyleNone;
//------
if fsStrikeOut in DBGD.Columns.Title.Font.Style then
ExcelApp.Selection.font.Strikethrough:= True
else ExcelApp.Selection.font.Strikethrough:= false;
st:=DBGD.Columns.Title.Caption;
I_width:=DBGD.Columns.Width/8.5;
if I_width>255 then I_width:=255;
if I_width<0 then I_width:=0;
EWorksheet.Columns[lie].ColumnWidth := I_width;
EWorksheet.Range[EWorksheet.Cells[hang,lie],
EWorksheet.Cells[hang,lie]].Font.Color:=
DBGD.Columns.Title.Font.Color;
EWorksheet.Range[EWorksheet.Cells[hang,lie],
EWorksheet.Cells[hang,lie]].font.Size:=
DBGD.Columns.Title.Font.Size;
EWorksheet.Range[EWorksheet.Cells[hang,lie],
EWorksheet.Cells[hang,lie]].font.Name:=
DBGD.Columns.Title.Font.Name;
// EWorksheet.Range[EWorksheet.Cells[hang,lie],
// EWorksheet.Cells[hang,lie]].

EWorksheet.Cells[hang,lie].Value :=st;
st:=PDBset.Fields.ClassName;
ExcelApp.Range[EWorksheet.Cells[hang+1,lie],
EWorksheet.Cells[PDBset.RecordCount+1,lie]].select;
if (st='TDateField') or (st='TDateTimeField') then
ExcelApp.Selection.NumberFormatLocal:= '[$-F800]dddd, mmmm dd, yyyy'
else if (st='TStringField') or (st='TWideStringField') then
ExcelApp.Selection.NumberFormatLocal:='@';
c:=DBGD.Columns.Color;
ExcelApp.Selection.Interior.Color:=ColorToRGB(c);
ExcelApp.Selection.HorizontalAlignment:=
GetExcelAlignment(DBGD.Columns.Alignment);
ExcelApp.Selection.font.FontStyle:=
GetExcelFontStyle(DBGD.Columns.Font.Style);
if fsUnderline in DBGD.Columns.Font.Style then
ExcelApp.Selection.font.Underline := xlUnderlineStyleSingle
else ExcelApp.Selection.font.Underline :=xlUnderlineStyleNone;
//----------
if fsStrikeOut in DBGD.Columns.Font.Style then
ExcelApp.Selection.font.Strikethrough:= True
else ExcelApp.Selection.font.Strikethrough:= false;
EWorksheet.Range[EWorksheet.Cells[hang+1,lie],
EWorksheet.Cells[PDBset.RecordCount+1,lie]].Font.Color:=
DBGD.Columns.Font.Color;
EWorksheet.Range[EWorksheet.Cells[hang+1,lie],
EWorksheet.Cells[PDBset.RecordCount+1,lie]].font.Size:=
DBGD.Columns.Font.Size;
EWorksheet.Range[EWorksheet.Cells[hang+1,lie],
EWorksheet.Cells[PDBset.RecordCount+1,lie]].font.Name:=
DBGD.Columns.Font.Name;

end; //end for i:=0 to PDBset.FieldCount-1
datas:=varArrayCreate([1,PDBset.RecordCount,1,lie],varVariant);
PDBset.First;
PDBset.DisableControls;
while not PDBset.Eof do
begin
inc(hang);
lie:=0;
for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
begin
inc(lie);
datas[hang-1,lie]:=PDBset.Fields.Value;
end; //end for i:=0 to PDBset.FieldCount-1
PDBset.Next;
end;// while not PDBset.Eof
//-------设置borders-------
EWorksheet.Range[EWorksheet.cells[1,1],
EWorksheet.cells[PDBset.RecordCount+1,lie]].select;
ExcelApp.Selection.Borders[xlDiagonalDown].LineStyle := xlNone;
ExcelApp.Selection.Borders[xlDiagonalUp].LineStyle := xlNone ;
ExcelApp.Selection.Borders[xlEdgeLeft].LineStyle := xlContinuous;
ExcelApp.Selection.Borders[xlEdgeLeft].Weight := xlHairline;
ExcelApp.Selection.Borders[xlEdgeLeft].ColorIndex := xlAutomatic;
ExcelApp.Selection.Borders[xlEdgeTop].LineStyle := xlContinuous;
ExcelApp.Selection.Borders[xlEdgeTop].Weight := xlHairline;
ExcelApp.Selection.Borders[xlEdgeTop].ColorIndex := xlAutomatic;
ExcelApp.Selection.Borders[xlEdgeBottom].LineStyle := xlContinuous;
ExcelApp.Selection.Borders[xlEdgeBottom].Weight := xlHairline;
ExcelApp.Selection.Borders[xlEdgeBottom].ColorIndex := xlAutomatic;
ExcelApp.Selection.Borders[xlEdgeRight].LineStyle := xlContinuous;
ExcelApp.Selection.Borders[xlEdgeRight].Weight := xlHairline;
ExcelApp.Selection.Borders[xlEdgeRight].ColorIndex := xlAutomatic;
if (dgColLines in DBGD.Options) then
begin
ExcelApp.Selection.Borders[xlInsideVertical].LineStyle := xlContinuous;
ExcelApp.Selection.Borders[xlInsideVertical].Weight := xlHairline;
ExcelApp.Selection.Borders[xlInsideVertical].ColorIndex := xlAutomatic;
end;
if (dgRowLines in DBGD.Options) then
begin
ExcelApp.Selection.Borders[xlInsideHorizontal].LineStyle := xlContinuous;
ExcelApp.Selection.Borders[xlInsideHorizontal].Weight := xlHairline;
ExcelApp.Selection.Borders[xlInsideHorizontal].ColorIndex := xlAutomatic;
end;
//------end 设置borders-------
EWorksheet.Range[EWorksheet.cells[2,1],
EWorksheet.cells[PDBset.RecordCount+1,lie]].Value2:=datas;
result:=true;
ExcelApp.Range[EWorksheet.Cells[1,1],
EWorksheet.Cells[1,1]].select ;
// ExcelApp.Visible := true;
finally
ExcelApp.Visible := true;
PDBset.EnableControls;
datas:=Unassigned;
// ExcelApp.quit;
ExcelApp:=Unassigned;
MyWorkBook:=Unassigned;
EWorksheet:=Unassigned;
end;
end;
 
用我的控件不需要用户的机器上装有Office Excel应用程序,也不用创建OLE对象,即可实现对EXCEL文件的读写,
或把Grid数据导出到EXCEL,速度快,程序可靠。通过用格式化的TXT文件实现应用程序和EXCEL文件之间的数据交换
QQ:292044357
 
你的方法,使用那个文本时最后还不是要打开excel .excel自带将格式文本导入得功能.
下列函数产生得文本文件用excel打开时 选Tab做分隔符即可!
function DBGridExp_Txt(DBGD:TDBgrid;Fname:TfileName):boolean;
var
f: textfile;
i:integer;
PDBset:^TADODataSet;
DateSeparator_Tmp:char;
ShortDateFormat_tmp:string;
st:string;
begin

DateSeparator_Tmp:=DateSeparator;// := '-';
ShortDateFormat_tmp:=ShortDateFormat; //:= 'yyyy-mm-dd';
DateSeparator:='-';
ShortDateFormat:='YYYY年mm月dd日';
PDBset:=@DBGD.DataSource.DataSet;
try

result:=false;
st:='';
assignfile(f,Fname);
rewrite(f);
PDBset.DisableControls;
for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
st:=st+#9+DBGD.Columns.Title.Caption;
writeln(f,st);
st:='';
PDBset.First;
while not PDBset.Eof do
begin
for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
st:=st+#9+PDBset.Fields.AsString;
writeln(f,st);
st:='';
PDBset.Next;
end;// while not PDBset.Eof
close(f);
result:=true;
finally
DateSeparator:=DateSeparator_tmp;
ShortDateFormat:=ShortDateFormat_tmp;
PDBset.EnableControls;
end;
end;
 
用我的控件不需要用户的机器上装有Office Excel应用程序,也不用创建OLE对象,即可实现对EXCEL文件的读写,
或把Grid数据导出到EXCEL,速度快,程序可靠。通过用格式化的TXT文件实现应用程序和EXCEL文件之间的数据交换,建议你试一下
QQ:292044357
 
多人接受答案了。
 

Similar threads

I
回复
0
查看
547
import
I
I
回复
0
查看
719
import
I
I
回复
0
查看
843
import
I
后退
顶部