高手请帮忙!!!怎么自动调整从dbgrid(有上百行,20列)中的数据输出到Word?(100分)

  • 主题发起人 主题发起人 gxhu
  • 开始时间 开始时间
G

gxhu

Unregistered / Unconfirmed
GUEST, unregistred user!
把Dbgrid控件中的数据输出到Word后,怎样使数据显示格式自动调整到最佳(能自动调整表格和单元的大小)?
高手帮忙指出我程序中的不足之处:(分数不够可再加!!!)

procedure TF_ConditionQuery.DbGrid_to_Word(DbGrid:TDbGrid; Rowcount, ColCount:integer; Title:string);
var
Lang: string;
MSWord: Variant;
c,r,j:integer;
begin
try
MsWord := CreateOleObject('Word.Basic');
except
ShowMessage('不能启动Microsoft Word!');
Exit;
end;
try
{ Return Application Info. This call is the same for English and
French Microsoft Word. }
Lang := MsWord.AppInfo(Integer(16));
except
try
{ for German Microsoft Word the procedure name is translated }
Lang := MsWord.AnwInfo(Integer(16));
except
{ if this procedure does not exist there is a different translation of
Microsoft Word }
ShowMessage('Microsoft Word version is not German, French or English.');
Exit;
end;
end;
with DbGrid do
begin
try
r:=rowcount+1; c:=ColCount;
{ if (Lang = 'English (US)') or (Lang = 'English (UK)') or (Lang = '简体中文(中国)') then
begin}
MsWord.AppShow;
MSWord.FileNew;
MsWord.MsgBox('正在创建报表...请稍候','',-1);

msword.screenupdating(1);
msword.startofdocument;
//title
msword.insert(title+#13);
MSWord.LineUp(1, 1);
msword.centerpara;
msword.endofdocument;
msword.insert('制表日期:'+datetostr(date)+#13);
msword.leftpara;
msword.endofdocument;
//data
msword.tableinserttable(0, c, r, 0, 0, 16, 166);
try
for j:=0 to c-1 do begin
msword.insert(Fields[j].DisplayLabel);
msword.nextcell;
end;

DataSource.DataSet.First;
While not DataSource.DataSet.Eof do begin
for j:=0 to c-1 do begin
msword.insert(Fields[j].AsString);
msword.nextcell;
end;
DataSource.DataSet.Next;
end;
finally
end;

msword.tabledeleterow;
// msword.startofdocument;
// msword.tableselectrow;
// msword.tableheadings(1);
// msword.centerpara;
msword.screenrefresh;
msword.screenupdating(1);

{ MSWord.Insert(S);
MSWord.LineUp(L, 1);
MSWord.TextToTable(ConvertFrom := 2, NumColumns := 3);
}
MsWord.MsgBox('创建报表完毕!','',-1);
{end;}
finally
// Close;
end;
end;
end;
 
你可以用这个来控制长度.WD.Tables.Item(i).Cell(4,4).range.Columns.Width:=55;
这是我以前用过的,因为表比较复杂,不但有合并且每行宽度并不一样,所以下面比较杂乱,
但看看代码一定有收获.若你的每列都对齐的话,那很简单.最好先算出列宽再定义就最好.
若表格比较复杂,那就比较麻烦.若这样的话,我是不太提倡用WORD来生成表格,不如用EXCEL
或其他专用打印工具.

procedure TFrmCompany.WriteToWord;
var Template,NewTemplate,ItemIndex,PageNumberAlignment:OleVariant;
// MRange:Variant;
Count_Var:OleVariant;
// Table:OleVariant;
// un_Var,ex_Var,cnt_Var,
un_Var,un_DownVar,ex_Var,Start_var,End_Var,Down_Var,Up_Var:OleVariant;
Bool_var:OleVariant;
i:integer;
CWidth:array[0..8] of single;
begin
CWidth[0]:=45;
CWidth[1]:=80;
CWidth[2]:=35;
CWidth[3]:=240;
CWidth[4]:=400;
CWidth[5]:=355;
CWidth[6]:=150;
CWidth[7]:=275;
CWidth[8]:=55;
Template := EmptyParam;
// NewTemplate := True;
NewTemplate := False;
ItemIndex:=1;
// try
WA.Connect;
{ except
WA.Disconnect;
ShowMessage('Please try again!');
abort;
end;}
WA.Visible:=True;
WA.Documents.Add(Template, NewTemplate);
WD.ConnectTo(WA.Documents.Item(ItemIndex));

PageNumberAlignment:=wdAlignPageNumberCenter;
Bool_var:=True;
WA.Selection.Sections.Item(1).Footers.Item(1).PageNumbers.Add(PageNumberAlignment,Bool_Var);
// Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True

Bool_var:=False;
AdoQryCompany.First;
i:=1;
// for i:=1 to AdoQryCompany.RecordCount do
while not AdoQryCompany.Eof do
begin
// WD.Tables.Add(WD.Range,7,4);
WD.Range.InsertAfter(#13);
WD.Tables.Add(WA.selection.Range,9,4);

un_Var:=wdCharacter; //第一行
Start_Var:=1;
End_Var:=4;
ex_Var:=wdExtend;
WA.Selection.MoveRight(un_Var,End_Var,ex_Var);
WA.Selection.Cells.Merge;
WA.Selection.TypeText(AdoQryCompany.FieldByName('province').AsString);
WA.Selection.Cells.Item(1).SetWidth(CWidth[4],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;

un_DownVar:=wdLine;
Down_Var:=1;
ex_Var:=wdMove;
// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var); //第二行不變
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var); //第二行
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[2],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[7],wdAdjustNone);

// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var); //第三行
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
Start_Var:=1;
End_Var:=3;
ex_Var:=wdMove;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
ex_Var:=wdExtend;
// WA.Selection.MoveLeft(un_Var,Start_Var,ex_Var);
WA.Selection.MoveRight(un_Var,End_Var,ex_Var);
WA.Selection.Cells.Merge;
WA.Selection.Cells.Item(1).SetWidth(CWidth[5],wdAdjustNone);

// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var);
// WA.Selection.MoveLeft(un_Var,Start_Var,ex_Var);
ex_Var:=wdMove;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);

WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone); //第四行
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
Count_Var:=3;
WA.Selection.Cells.Split(Down_var,Count_var,Bool_Var);
WA.Selection.MoveLeft(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[1],wdAdjustNone);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[2],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[6],wdAdjustNone);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);

WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone); //第五行
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[1],wdAdjustNone);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[2],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[3],wdAdjustNone);

ex_Var:=wdMove;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var); //第六行
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[2],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[7],wdAdjustNone);

// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var); //第七行
ex_Var:=wdMove;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone);
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
End_Var:=3;
ex_Var:=wdExtend;
WA.Selection.MoveRight(un_Var,End_Var,ex_Var);
WA.Selection.Cells.Merge;
WA.Selection.Cells.Item(1).SetWidth(CWidth[5],wdAdjustNone);

ex_Var:=wdMove;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var); //第八行
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone); //第七行
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
End_Var:=3;
ex_Var:=wdExtend;
WA.Selection.MoveRight(un_Var,End_Var,ex_Var);
WA.Selection.Cells.Merge;
WA.Selection.Cells.Item(1).SetWidth(CWidth[5],wdAdjustNone);

// Down_Var:=1; //第九行
// ex_Var:=wdMove;
// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var);
ex_Var:=wdMove;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
WA.Selection.Cells.Item(1).SetWidth(CWidth[0],wdAdjustNone); //第七行
WA.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
// Start_Var:=1;
// ex_Var:=wdMove;
// WA.Selection.MoveRight(un_Var,Start_Var,ex_Var);
End_Var:=3;
ex_Var:=wdExtend;
WA.Selection.MoveRight(un_Var,End_Var,ex_Var);
WA.Selection.Cells.Merge;
WA.Selection.Cells.Item(1).SetWidth(CWidth[5],wdAdjustNone);
ex_Var:=wdMove;

End_Var:=3;
WA.Selection.MoveRight(un_Var,End_Var,ex_Var);

if txtOK then
WD.Tables.Item(i).Cell(2,1).Range.Text:=lblData[0]
else
WD.Tables.Item(i).Cell(2,1).Range.Text:='ID';
WD.Tables.Item(i).Cell(2,2).Range.Text:=AdoQryCompany.FieldByName('ID').AsString;
if txtOK then
WD.Tables.Item(i).Cell(2,3).Range.Text:=lblData[1]
else
WD.Tables.Item(i).Cell(2,3).Range.Text:='Name';
WD.Tables.Item(i).Cell(2,4).Range.Text:=AdoQryCompany.FieldByName('name').AsString;
if txtOK then
WD.Tables.Item(i).Cell(3,1).Range.Text:=lblData[5]
else
WD.Tables.Item(i).Cell(3,1).Range.Text:='Address';
WD.Tables.Item(i).Cell(3,2).Range.Text:=AdoQryCompany.FieldByName('address').AsString;
if txtOK then
WD.Tables.Item(i).Cell(4,1).Range.Text:=lblData[6]
else
WD.Tables.Item(i).Cell(4,1).Range.Text:='Tel';
WD.Tables.Item(i).Cell(4,2).Range.Text:=AdoQryCompany.FieldByName('tel').AsString;
if txtOK then
WD.Tables.Item(i).Cell(4,3).Range.Text:=lblData[7]
else
WD.Tables.Item(i).Cell(4,3).Range.Text:='Fax';
WD.Tables.Item(i).Cell(4,4).Range.Text:=AdoQryCompany.FieldByName('fax').AsString;
if txtOK then
WD.Tables.Item(i).Cell(4,5).Range.Text:=lblData[17]
else
WD.Tables.Item(i).Cell(4,5).Range.Text:='Post No';
WD.Tables.Item(i).Cell(4,6).Range.Text:=AdoQryCompany.FieldByName('postno').AsString;
if txtOK then
WD.Tables.Item(i).Cell(5,1).Range.Text:=lblData[8]
else
WD.Tables.Item(i).Cell(5,1).Range.Text:='LXR';
WD.Tables.Item(i).Cell(5,2).Range.Text:=AdoQryCompany.FieldByName('lxr').AsString;
if txtOK then
WD.Tables.Item(i).Cell(5,3).Range.Text:=lblData[9]
else
WD.Tables.Item(i).Cell(5,3).Range.Text:='Tel';
WD.Tables.Item(i).Cell(5,4).Range.Text:=AdoQryCompany.FieldByName('l_tel').AsString;

if txtOK then
WD.Tables.Item(i).Cell(6,1).Range.Text:=lblData[11]
else
WD.Tables.Item(i).Cell(6,1).Range.Text:='FeedBack';
WD.Tables.Item(i).Cell(6,2).Range.Text:=AdoQryCompany.FieldByName('feedback').AsString;
WD.Tables.Item(i).Cell(6,3).Range.Text:='Email';
WD.Tables.Item(i).Cell(6,4).Range.Text:=AdoQryCompany.FieldByName('email').AsString;

if txtOK then
WD.Tables.Item(i).Cell(7,1).Range.Text:=lblData[16]
else
WD.Tables.Item(i).Cell(7,1).Range.Text:='Memo';
WD.Tables.Item(i).Cell(7,2).Range.Text:=AdoQryCompany.FieldByName('memo').AsString;

if txtOK then
WD.Tables.Item(i).Cell(8,1).Range.Text:=lblData[18]
else
WD.Tables.Item(i).Cell(8,1).Range.Text:='Products';
WD.Tables.Item(i).Cell(8,2).Range.Text:=AdoQryCompany.FieldByName('products').AsString;

if txtOK then
WD.Tables.Item(i).Cell(9,1).Range.Text:=lblData[10]
else
WD.Tables.Item(i).Cell(9,1).Range.Text:='Notice';
WD.Tables.Item(i).Cell(9,2).Range.Text:=AdoQryCompany.FieldByName('notice').AsString;

{ WD.Tables.Item(i).Cell(4,1).range.Columns.Width:=35;
WD.Tables.Item(i).Cell(4,2).range.Columns.Width:=55;
WD.Tables.Item(i).Cell(4,3).range.Columns.Width:=35;
WD.Tables.Item(i).Cell(4,4).range.Columns.Width:=55;
WD.Tables.Item(i).Cell(4,5).range.Columns.Width:=35;
WD.Tables.Item(i).Cell(4,6).range.Columns.Width:=45;}

Down_Var:=1;
ex_Var:=wdMove;
// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var);
// WD.Range.InsertAfter(#13);
{ if ex_Var<>0 then showmessage('!!!');
try
WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var); //提一行
except
ShowMessage(AdoQryCompany.FieldByName('tel').AsString);
// ex_Var:=wdMove;
// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var); //提一行
end;}
// WD.Range.InsertAfter(#13);

// WD.Range.InsertAfter(#13);

// WD.Range(Start_Var,End_Var);
// Down_Var:=2;
ex_Var:=wdMove;

// WA.Selection.MoveDown(un_DownVar,Down_Var,ex_Var);

AdoQryCompany.Next;
inc(i);
end;
{ except
WA.Disconnect;
ShowMessage('Please try again!');
abort;
end;}
end;
 
设置模板,让表格宽度适应内容。
 
请问ccgaosong, 设了模板后怎么编程?
请问zhangkan, 我看了你的程序,我想请教一下,能不能在程序中设置Word的页面大小?
 
procedure TForm1.writecell(t,r,c:integer;txt:widestring);
begin
WordDocument.Tables.Item(t).Cell(r,c).Range.InsertAfter(txt);
end;
t:表格
r:行
c:列
txt:内容
 
再次请教ccgaosong,怎么调用模板?
 
procedure TForm1.opendot(templetes: string);
var Template,NewTemplate:OleVariant;
begin
try
Wordapplication.Connect;
except
MessageDlg('请安装Word2000或office2000以上版本。', mtError, [mbOk], 0);
Abort;
end;
WordApplication.Caption:='delphi doc';

Template:=templetes;
NewTemplate:=False;
WordApplication.Documents.add(Template,NewTemplate);
WordApplication.Visible := True;
WordDocument.ConnectTo(WordApplication.ActiveDocument);
end;

注意:Template用绝对路径加文件名(.dot)
 
首先非常感谢以上两位对我的支持!!!
因为最近几天放假,我的这个程序被暂时搁在一边,今天有时间来调试了.
我想再请教ccgaosong,我现在做了一个模板,有1行30列,这一行是表头的列字段名,
请问怎么样才能加上字段的内容并使各列对齐。
请一定帮我,我找不到这方面的资料(注:我可再给您加50分)
 
怎么没人近来?
 

procedure P_BB_prt(v_title, v_mx: string);
var
xlapp: TExcelApplication;
VL_BH1, VL_BH: string;
ksh, ksl, j: integer;
VL_Str: string;
VL_MBWJM, vl_bbmc, vl_bblx: string;
begin
if Table.Active = false then
table.active := true;
Vl_MBWJM := TableMBWJM.AsString;
Vl_BBMC := TableBBMC.AsString;
Vl_BBLX := TableBBLX.AsString;
xlapp.Connect;
xlapp.Workbooks.Add(GetCurrentDir + '/Templete/' + Vl_MBWJM, 0);
VL_BH := v_title + Vl_BBMC;
xlapp.Cells.Item[1, 1] := VL_BH;
xlapp.Cells.Item[2, 1] := V_mx;
//取开始行.开始列
ksh := tableksh.AsInteger;
ksl := tableksl.AsInteger;
Query.First;
while not Query.Eof do
begin
for j := ksl to Query.FieldCount + ksl - 1 do
xlapp.Cells.Item[ksh, j] := query.Fields[J - ksl].AsString;
ksh := ksh + 1;
Query.Next;
end;
xlapp.Visible[0] := True;
xlapp.Disconnect;
end;
 
peter_peng1980,谢谢你的帮助.
我看了你的程序,TableMBWJM, TableBBMC, TableBBLX不明白,无法编译?
 
我明白了.
但是我还想请教--有没有办法可以把Excel中多余的列和行(不是数据表中的记录)去掉(隐藏也行)?
 
procedure TForm1.writecell(t,r,c:integer;txt:widestring);
begin
WordDocument.Tables.Item(t).Cell(r,c).Range.InsertAfter(txt);
end;
t:表格
r:行
c:列
txt:内容
该程序只能写到模板中已有的单元格,可是我的模板只做了一个表头,记录行是程序动态
加上的。请问有没有办法实现?
 
procedure Tform1.printdemo();
var
tmpstr:widestring;
i:integer;
t,r,c:integer;
rownumber: OleVariant;
begin
t:=1;
r:=8-1;
c:=1;
query4.open;
WordDocument.Tables.Item(t).cell(r+1,c+1).select;
rownumber:= query4.recordcount-4;
if query4.recordcount>4 then begin
WordApplication.Selection.InsertRows(rownumber);
end;
for i:=1 to query4.RecordCount do begin
tmpstr:=query4.fieldbyname('field1').AsString;
WordDocument.Tables.Item(t).cell(r+i,c).range.InsertAfter(tmpstr);
tmpstr:=query4.fieldbyname('field2').AsString;
WordDocument.Tables.Item(t).cell(r+i,c+1).range.InsertAfter(tmpstr);
query4.Next;
end;
end;
注意:先在模板上添加4个空行,然后根据纪录数添加空行。
t:表格
r:行
c:列
 
谢谢光临!!!
请教ccgaosong,怎么样设置Word文档中任一行的属性(对齐、字体等)
 
在模板中设。
 
不在模板中设置怎么做?
 
可以在word里录制宏,手工做,然后将宏翻译成delphi程序。
对其他程序也适用。
 
宏翻译成delphi程序?怎么做?

 
后退
顶部