将数据库记录存为excel文件的问题 搜索以前的帖子吧~~太多了的~~ 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 unit Uprint;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OleCtnrs, StdCtrls, Buttons, Grids, DBGrids, ExtCtrls,comobj, DBCtrls,db, QuickRpt, Qrctrls, ComCtrls, ToolWin, QRPrntr,Excel97,Word97;type TForm4 = class(TForm) DBGrid1: TDBGrid; STBar: TStatusBar; Panel2: TPanel; BinExcel: TBitBtn; BinWord: TBitBtn; BinExt: TBitBtn; procedure BinWordClick(Sender: TObject); procedure BinExcelClick(Sender: TObject); procedure BinExtClick(Sender: TObject); procedure DBGrid1TitleClick(Column: TColumn); procedure FormShow(Sender: TObject); private { Private declarations } public XlsApp : OleVariant; XlsSheet: OleVariant; { Public declarations } end;var Form4: TForm4;implementationuses main, Udm,UPub;const xlWBATWorksheet = -4167;{$R *.DFM}procedure TForm4.FormShow(Sender: TObject);begin DBGrid1.Visible := true; dgredraw(Form1.sjk,'',DBGrid1);end;procedure TForm4.BinExcelClick(Sender: TObject);var I,J : Integer; TmpFileName : String; SelField,SelRec : Integer; PrintAll : Boolean;begin STBar.Panels[0].Text := ''; PrintAll := false; if DBGrid1.SelectedRows.Count = 0 then begin if MessageDlg('当前没有选定打印的记录,是否全部打印?',mtconfirmation,[Mbyes,Mbno],0) = mrno then begin Application.MessageBox(pchar('没有选定的数据记录,打印终止!'),pchar('注意'),mb_ok); Abort; end else PrintAll := true; end; try STBar.Panels[0].Text := '正在启动Excel...'; if VarIsEmpty(XlsApp) then XlsApp := Createoleobject('Excel.Application');// XlsApp.ActiveSheet.Name := 'DataTransTmp'; XLsApp.Workbooks.Add; XlsSheet := XLsApp.Worksheets['Sheet1'];// XlsSheet.Activesheets.Name := 'DataTransTmp'; except Application.MessageBox(pchar('Ms Excel 无法启动,数据转入终止!'),pchar('注意'),mb_ok); BinExcel.Enabled := false; STBar.Panels[0].Text := 'Excel无法启动'; Abort; end; STBar.Panels[0].Text := '数据正在转移至Excel'; SelField := 0; for J := 0 to Dbgrid1.Columns.Count-1 do begin if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].color<>clgray) then begin SelField := SelField + 1; XlsSheet.Cells[3, SelField] := dbgrid1.Columns[j].Title.Caption; end; end; SelRec := 0; with dm1.QryMain do begin first; for I := 0 to RecordCount-1 do begin if not PrintAll then begin if not DBGrid1.SelectedRows.CurrentRowSelected then begin Next; Continue end; end; SelRec := SelRec + 1; SelField := 0; for J := 0 to Dbgrid1.Columns.Count-1 do begin if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].color<>clAqua) then begin SelField := SelField + 1; if StrToIntDef(Fields[J].AsString, -1) <> -1 then XlsSheet.Cells[selRec + 3, SelField] := '''' + Fields[J].Asstring else XlsSheet.Cells(selRec + 3, SelField) := Fields[J].Asstring end; end; Next; end; end; XlsApp.Visible := true; STBar.Panels[0].Text := '数据转移成功,请使用Excel打印所选定的数据';{ Application.MessageBox(pchar('数据已转入至Excel文件中,请于下列路径中查看:' + #13#10 + ' ' + TmpFileName),pchar('注意'),mb_ok);}end;procedure TForm4.BinWordClick(Sender: TObject);var WordApp,WordDoc,WordParagraph,WordRange,WordTable:variant; SltRec,SltCol,VisCol :integer; ColIndex,RowIndex : Integer; I,J : integer; PrintAll : Boolean;begin STBar.Panels[0].Text := ''; PrintAll := false; if DBGrid1.SelectedRows.Count = 0 then begin if MessageDlg('当前没有选定打印的记录,是否全部打印?',mtconfirmation,[Mbyes,Mbno],0) = mrno then begin Application.MessageBox(pchar('没有选定的数据记录,打印终止!'),pchar('注意'),mb_ok); Abort; end else PrintAll := true; end; try if VarIsEmpty(WordApp) then WordApp := CreateOleObject('word.Application'); WordDoc := WordApp.documents.add; WordParagraph := WordApp.activedocument.paragraphs.add; WordRange := WordParagraph.range; // WordRange.text:= dm1.QryMain.TableName +#13+' '; WordRange.Font.Size := 18; WordRange.Font.Name := '宋体'; // WordRange.Font.style := fsbold; except Application.MessageBox(pchar('Ms Word 无法启动,数据转入终止!'),pchar('注意'),mb_ok); BinWord.Enabled := false; STBar.Panels[0].Text := 'Ms Word 无法启动'; Abort; end; STBar.Panels[0].Text := '数据正在转移至Word'; //统计打印行数 if PrintAll then SltRec := dm1.QryMain.RecordCount else SltRec:=DBGrid1.SelectedRows.Count; //统计打印列数 SltCol := 0; VisCol := 0; for j := 0 to DBGrid1.Columns.Count-1 do begin if DBGrid1.Columns[J].Visible then begin VisCol := VisCol + 1; if DBGrid1.Columns[j].Title.Color=clAqua then begin SltCol := SltCol + 1; end; end; end; if SltCol = 0 then SltCol := VisCol; WordRange := WordApp.ActiveDocument.Content; WordRange.Collapse(wdCollapseEnd); WordTable:= WordApp.activedocument.tables.add(WordRange,SltRec + 1,SltCol); {打印表头} ColIndex := 1; for j := 0 to dbgrid1.Columns.Count-1 do begin if SltCol <> VisCol then begin if (dbgrid1.Columns[j].Visible = false) or (dbgrid1.Columns[j].Title.color <> clAqua) then Continue; end; WordTable.Cell(1,ColIndex).Range.InsertAfter(dbgrid1.Columns[j].Title.Caption); DBGrid1.Columns[J].Title.Color := clAqua; ColIndex := ColIndex + 1; end; //打印数据 dm1.QryMain.First; RowIndex := 2; ColIndex := 1; while not dm1.QryMain.Eof do begin if SltRec <> dm1.QryMain.RecordCount then begin if dbgrid1.SelectedRows.CurrentRowSelected = false then begin dm1.QryMain.Next; Continue; end; end; for j := 0 to dbgrid1.Columns.Count-1 do begin if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].Title.color=clAqua) then begin WordTable.Cell(RowIndex,ColIndex).Range.InsertAfter (dm1.QryMain.Fieldbyname(dbgrid1.Columns[j].FieldName).asstring); ColIndex := ColIndex + 1; end; end; RowIndex := RowIndex + 1; ColIndex := 1; dm1.QryMain.Next; end;{End of While...not...} WordApp.Visible := true; STBar.Panels[0].Text := '数据转移成功,请使用Word打印所选定的数据'; for j := 0 to dbgrid1.Columns.Count-1 do DBGrid1.Columns[J].Title.Color := clAqua;end;procedure TForm4.BinExtClick(Sender: TObject);begin{ TmpFileName := 'C:\My Documents\' + Form1.sjk + IntToStr(random(1000)) + '.xls'; XlsSheet.SaveAs(TmpFileName); XlsSheet.Application.Quit;}{ if not VarIsEmpty(XlsApp) then begin XlsApp.DisplayAlerts := True; // 7Discard unsaved files.... try XlsApp.Application.Quit; except end; end;} close;end;procedure TForm4.DBGrid1TitleClick(Column: TColumn);begin if column.Color=clAqua then Column.Color:=clwindow else if column.Color=clAqua then column.Color:=clgray;end; 新手请教内存地址错误的debug问题 adoquery+dbgrid问题.. 特急!哪位大侠救救我呀!关于模拟按键的问题, 怎样将shape控件始终显示出来,也就是不被其他组件遮盖住?? 如何使用OpenDialog啊? 急急急 各位老兄帮帮忙!!!!! 在DBGrid中启用picklist? AutoCAD 文件如何在我的窗体中显示? 关于ActiveX!在线等!!! 能不能在控件中调色,而不是用DELPHI本来提供的那写颜色?? delphi中报表的问题 怎样才能从TDateTime 中取出月份
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtnrs, StdCtrls, Buttons, Grids, DBGrids, ExtCtrls,comobj, DBCtrls,db,
QuickRpt, Qrctrls, ComCtrls, ToolWin, QRPrntr,Excel97,Word97;type
TForm4 = class(TForm)
DBGrid1: TDBGrid;
STBar: TStatusBar;
Panel2: TPanel;
BinExcel: TBitBtn;
BinWord: TBitBtn;
BinExt: TBitBtn;
procedure BinWordClick(Sender: TObject);
procedure BinExcelClick(Sender: TObject);
procedure BinExtClick(Sender: TObject);
procedure DBGrid1TitleClick(Column: TColumn);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
XlsApp : OleVariant;
XlsSheet: OleVariant;
{ Public declarations }
end;var
Form4: TForm4;implementationuses main, Udm,UPub;
const
xlWBATWorksheet = -4167;
{$R *.DFM}
procedure TForm4.FormShow(Sender: TObject);
begin
DBGrid1.Visible := true;
dgredraw(Form1.sjk,'',DBGrid1);
end;procedure TForm4.BinExcelClick(Sender: TObject);
var
I,J : Integer;
TmpFileName : String;
SelField,SelRec : Integer;
PrintAll : Boolean;
begin
STBar.Panels[0].Text := '';
PrintAll := false;
if DBGrid1.SelectedRows.Count = 0 then
begin
if MessageDlg('当前没有选定打印的记录,是否全部打印?',mtconfirmation,[Mbyes,Mbno],0) = mrno then
begin
Application.MessageBox(pchar('没有选定的数据记录,打印终止!'),pchar('注意'),mb_ok);
Abort;
end else
PrintAll := true;
end; try
STBar.Panels[0].Text := '正在启动Excel...';
if VarIsEmpty(XlsApp) then
XlsApp := Createoleobject('Excel.Application');
// XlsApp.ActiveSheet.Name := 'DataTransTmp';
XLsApp.Workbooks.Add;
XlsSheet := XLsApp.Worksheets['Sheet1'];
// XlsSheet.Activesheets.Name := 'DataTransTmp';
except
Application.MessageBox(pchar('Ms Excel 无法启动,数据转入终止!'),pchar('注意'),mb_ok);
BinExcel.Enabled := false;
STBar.Panels[0].Text := 'Excel无法启动';
Abort;
end; STBar.Panels[0].Text := '数据正在转移至Excel'; SelField := 0;
for J := 0 to Dbgrid1.Columns.Count-1 do
begin
if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].color<>clgray) then
begin
SelField := SelField + 1;
XlsSheet.Cells[3, SelField] := dbgrid1.Columns[j].Title.Caption;
end;
end; SelRec := 0;
with dm1.QryMain do
begin
first;
for I := 0 to RecordCount-1 do
begin
if not PrintAll then
begin
if not DBGrid1.SelectedRows.CurrentRowSelected then
begin
Next;
Continue
end;
end; SelRec := SelRec + 1;
SelField := 0;
for J := 0 to Dbgrid1.Columns.Count-1 do
begin
if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].color<>clAqua) then
begin
SelField := SelField + 1;
if StrToIntDef(Fields[J].AsString, -1) <> -1 then
XlsSheet.Cells[selRec + 3, SelField] := '''' + Fields[J].Asstring
else
XlsSheet.Cells(selRec + 3, SelField) := Fields[J].Asstring
end;
end;
Next;
end;
end;
XlsApp.Visible := true;
STBar.Panels[0].Text := '数据转移成功,请使用Excel打印所选定的数据';
{ Application.MessageBox(pchar('数据已转入至Excel文件中,请于下列路径中查看:' + #13#10
+ ' ' + TmpFileName),pchar('注意'),mb_ok);}
end;procedure TForm4.BinWordClick(Sender: TObject);
var
WordApp,WordDoc,WordParagraph,WordRange,WordTable:variant;
SltRec,SltCol,VisCol :integer;
ColIndex,RowIndex : Integer;
I,J : integer;
PrintAll : Boolean;
begin
STBar.Panels[0].Text := '';
PrintAll := false;
if DBGrid1.SelectedRows.Count = 0 then
begin
if MessageDlg('当前没有选定打印的记录,是否全部打印?',mtconfirmation,[Mbyes,Mbno],0) = mrno then
begin
Application.MessageBox(pchar('没有选定的数据记录,打印终止!'),pchar('注意'),mb_ok);
Abort;
end else
PrintAll := true;
end; try
if VarIsEmpty(WordApp) then
WordApp := CreateOleObject('word.Application'); WordDoc := WordApp.documents.add;
WordParagraph := WordApp.activedocument.paragraphs.add; WordRange := WordParagraph.range;
// WordRange.text:= dm1.QryMain.TableName +#13+' ';
WordRange.Font.Size := 18;
WordRange.Font.Name := '宋体';
// WordRange.Font.style := fsbold;
except
Application.MessageBox(pchar('Ms Word 无法启动,数据转入终止!'),pchar('注意'),mb_ok);
BinWord.Enabled := false;
STBar.Panels[0].Text := 'Ms Word 无法启动';
Abort;
end;
STBar.Panels[0].Text := '数据正在转移至Word'; //统计打印行数
if PrintAll then
SltRec := dm1.QryMain.RecordCount
else
SltRec:=DBGrid1.SelectedRows.Count; //统计打印列数
SltCol := 0;
VisCol := 0;
for j := 0 to DBGrid1.Columns.Count-1 do
begin
if DBGrid1.Columns[J].Visible then
begin
VisCol := VisCol + 1; if DBGrid1.Columns[j].Title.Color=clAqua then
begin
SltCol := SltCol + 1;
end;
end;
end;
if SltCol = 0 then
SltCol := VisCol; WordRange := WordApp.ActiveDocument.Content;
WordRange.Collapse(wdCollapseEnd);
WordTable:= WordApp.activedocument.tables.add(WordRange,SltRec + 1,SltCol); {打印表头}
ColIndex := 1;
for j := 0 to dbgrid1.Columns.Count-1 do
begin
if SltCol <> VisCol then
begin
if (dbgrid1.Columns[j].Visible = false) or (dbgrid1.Columns[j].Title.color <> clAqua) then
Continue;
end; WordTable.Cell(1,ColIndex).Range.InsertAfter(dbgrid1.Columns[j].Title.Caption);
DBGrid1.Columns[J].Title.Color := clAqua;
ColIndex := ColIndex + 1;
end; //打印数据
dm1.QryMain.First;
RowIndex := 2;
ColIndex := 1;
while not dm1.QryMain.Eof do
begin
if SltRec <> dm1.QryMain.RecordCount then
begin
if dbgrid1.SelectedRows.CurrentRowSelected = false then
begin
dm1.QryMain.Next;
Continue;
end;
end; for j := 0 to dbgrid1.Columns.Count-1 do begin
if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].Title.color=clAqua) then
begin
WordTable.Cell(RowIndex,ColIndex).Range.InsertAfter
(dm1.QryMain.Fieldbyname(dbgrid1.Columns[j].FieldName).asstring);
ColIndex := ColIndex + 1;
end;
end;
RowIndex := RowIndex + 1;
ColIndex := 1;
dm1.QryMain.Next;
end;{End of While...not...}
WordApp.Visible := true;
STBar.Panels[0].Text := '数据转移成功,请使用Word打印所选定的数据';
for j := 0 to dbgrid1.Columns.Count-1 do
DBGrid1.Columns[J].Title.Color := clAqua;
end;procedure TForm4.BinExtClick(Sender: TObject);
begin
{ TmpFileName := 'C:\My Documents\' + Form1.sjk + IntToStr(random(1000)) + '.xls';
XlsSheet.SaveAs(TmpFileName);
XlsSheet.Application.Quit;}{ if not VarIsEmpty(XlsApp) then
begin
XlsApp.DisplayAlerts := True; // 7Discard unsaved files....
try
XlsApp.Application.Quit;
except
end;
end;} close;
end;procedure TForm4.DBGrid1TitleClick(Column: TColumn);
begin
if column.Color=clAqua then
Column.Color:=clwindow
else
if column.Color=clAqua then
column.Color:=clgray;
end;