使用 delphi 控制 word.txt

大量Delphi开发资料

一个控制 Word 插入表格的代码:

procedure TForm1.MakeWordFile(const UserID : string);
var
 Bookmark: TBookmark;
 RangeW: Word97.Range;
 v1: Variant;
 ov1: OleVariant;
 Row1: Word97.Row;
 sQANDD : string;//问题与难点
 sMemo : string;//备注
 sSender:string;//提交人
 sPOSTDATE :string;//提交日期
 fName : OleVariant;
 sUserName : string;//
 sfName : string;
 i , j  : integer;

begin
 // insert title
 WordDocument1.Range.Text := '文档标题';
 //格式必须在最后设置
 WordDocument1.PageSetup.Orientation := wdOrientLandscape;//横向
 WordDocument1.Range.Font.Size := 14;
 WordDocument1.Range.Font.Bold := 0;

 WordDocument1.Tables.Add (WordDocument1.Words.Last,Table1.RecordCount+1,5,EmptyParam,EmptyParam);
 WordDocument1.Tables.Item(1).Cell(1,1).Range.Text := '格1';
 WordDocument1.Tables.Item(1).Cell(1,2).Range.Text := '格2';
 WordDocument1.Tables.Item(1).Cell(1,3).Range.Text := '格3';
 WordDocument1.Tables.Item(1).Cell(1,4).Range.Text := '格4';
 WordDocument1.Paragraphs.Last.Range.Text := ' ';//必须填这句，否则两个表格就粘合在一起了
 WordDocument1.Tables.Item(1).Cell(1,5).Range.Text := '格5';
 Table1.First;
 for i := 1 to Table1.RecordCount  do
 begin
   WordDocument1.Tables.Item(1).Cell(1+i,1).Range.Text := Table1.FieldByName('ITEM').AsString;
   WordDocument1.Tables.Item(1).Cell(1+i,2).Range.Text := Table1.FieldByName('Description').AsString;
   WordDocument1.Tables.Item(1).Cell(1+i,3).Range.Text := Table1.FieldByName('Result').AsString;
   WordDocument1.Tables.Item(1).Cell(1+i,4).Range.Text := Table1.FieldByName('MEASURE').AsString;
   WordDocument1.Tables.Item(1).Cell(1+i,5).Range.Text := Table1.FieldByName('POSTDATE').AsString;
   Table1.Next;
 end;

 WordDocument1.Tables.Add(WordDocument1.Words.Last,Table2.RecordCount +1,2,EmptyParam,EmptyParam);
 WordDocument1.Tables.Item(2).Cell(1,1).Range.Text := '其它';
 WordDocument1.Tables.Item(2).Cell(1,2).Range.Text := '备注';

 Table2.First;
 for i := 1 to Table2.RecordCount  do
 begin
   WordDocument1.Tables.Item(2).Cell(1+i,1).Range.Text := Table2.FieldByName ('QANDD').AsString;
   WordDocument1.Tables.Item(2).Cell(1+i,2).Range.Text := Table2.FieldByName ('MEMO').AsString;
   Table2.Next;
 end;
 //***********************设置标题文字格式*********************************
 WordDocument1.Paragraphs.Item(1).Range.Select;
 WordDocument1.Paragraphs.Item(1).Range.Font.Size := 30;
 WordDocument1.Application.Selection.ParagraphFormat.Alignment := wdAlignParagraphCenter;
 //****************************保存文件****************************************
 sUserName := lstUser.Items[lstUser.ItemIndex];
 ZipStr(sUserName, #10);
 sfName := Trim(edFileDir.Text)+'\' + sUserName + ' ' + Trim(edDate.Text)+'.doc';
 fName := sfname;
 //保存
 WordDocument1.SaveAs2000(fname);
 WordDocument1.Close;//关闭
end;   



2003-11-28 10:09:00    
 查看评语???     

 2003-11-28 10:12:35    控制使用 word 模板procedure TFrmMain.SpeedButton9Click(Sender: TObject);
Var
StrTemp : String;
ZS : Integer;
Nian, Yue, Ri : Word;

ItemIndex :OleVariant;
FileName, ConfirmConversions, ReadOnly, AddToRecentFiles,
PasswordDocument, PasswordTemplate, Revert,
WritePasswordDocument, WritePasswordTemplate, Format: OleVariant;

FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike,
MatchAllWordForms, Forward, Wrap, ReplaceWith, Replace: OleVariant;

SaveChanges, OriginalFormat, RouteDocument: OleVariant;
begin
FileName := ExtractFilePath(ParamStr(0)) + 'DOC\考察材料.DOC';
try
//  WordApplication1.Disconnect;
WordApplication1.Connect;
except
Application.MessageBox('连接WORD服务器失败，请确定您已经正确安装。','错误框',MB_OK+MB_ICONSTOP);
Abort;
end;

try
Frmjd := TFrmjd.Create(Self);

//显示进度
Frmjd.ProgressBar1.Max:=100;
Frmjd.Show;

WordApplication1.Visible := False;
WordApplication1.Caption := '干部考察材料';

//参数赋值
ConfirmConversions := False;
ReadOnly := False;
AddToRecentFiles := False;
PasswordDocument := '';
PasswordTemplate := '';
Revert := True;
WritePasswordDocument := '';
WritePasswordTemplate := '';
Format := wdOpenFormatDocument;

//打开文档（摸板）
WordApplication1.Documents.Openold( FileName, ConfirmConversions,
  ReadOnly, AddToRecentFiles, PasswordDocument, PasswordTemplate,
  Revert, WritePasswordDocument, WritePasswordTemplate, Format );


{Assign WordDocument component}
ItemIndex := 1;
WordDocument1.ConnectTo(WordApplication1.Documents.Item(ItemIndex));

{Turn Spell checking of because it takes a long time if enabled and slows down Winword}
WordApplication1.Options.CheckSpellingAsYouType := False;
WordApplication1.Options.CheckGrammarAsYouType := False;

//让Word替换标记字符串要使用WordDocument.Range.Find.Execute：姓名
FindText := '<#XM>';
MatchCase := False;
MatchWholeWord := True;
MatchWildcards := False;
MatchSoundsLike := False;
MatchAllWordForms := False;
Forward := True;
Wrap := wdFindContinue;
Format := False;
ReplaceWith := DM.ADOQryMainXM.Value;
Replace := wdReplaceAll;
WordDocument1.Range.Find.Executeold( FindText, MatchCase, MatchWholeWord,
  MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
  Wrap, Format, ReplaceWith, Replace );
Frmjd.ProgressBar1.Position := 10;//进度
Frmjd.Update;//进度窗口刷新

直接在WORD模版上写出<#name>。
FindText := '<#XM>';//这个是模板中的标记。
MatchCase := False;//匹配大小写。
MatchWholeWord := True;//匹配整个词语，这个不管，添True就行
MatchWildcards := False;//不清楚，这个不管，添False就行
MatchSoundsLike := False;//不清楚，这个不管，添False就行
MatchAllWordForms := False;//不清楚，这个不管，添False就行
Forward := True;//不清楚，这个不管，添True就行
Wrap := wdFindContinue;//不清楚，这个不管，用wdFindContinue就行
Format := False;//不清楚，这个不管，添False就行
ReplaceWith := DM.ADOQryMainXM.Value;//数据库的内容啊。
Replace := wdReplaceAll;//全部替换。 

 
 2003-11-28 10:25:03    Delphi＋Word解决方案参考[转]   这是我做项目过程中自己做的几个函数，见到大家都在问Word的问题。现在拿出来和大家共享。（希望有朋友可以进一步添加新的功能，或者做成包或者lib等，更方便大家使用。我自己是没有时间啦，呵呵）

   使用前，先根据需要建立一个空的WORD文件作为模板，在模板文件中设置好各种格式和文本。另外，其中的PrnWordTable的参数是TDBGridEh类型的控件，取自Ehlib2.6

   其中用到的shFileCopy函数（用于复制文件）和guiInfo函数（用于显示消息框）也是自己编写的，代码也附后。

示范代码如下：

代码完成的功能：
 1. 替换打印模板中的“#TITLE#”文本为“示范代码1”
 2. 并且将DBGridEh1控件当前显示的内容插入到文档的末尾
 3. 在文档末尾插入一个空行
 4. 在文档末尾插入新的一行文本
 5. 将文档中的空行去掉

if PrnWordBegin('C:\打印模板.DOC','C:\目标文件1.DOC') then
begin
  PrnWordReplace('#TITLE#','示范代码1');
  PrnWordTable(DBGridEh1);
  PrnWordInsert('');
  PrnWordInsert('这是新的一行文本');
  PrnWordReplace('^p^p','^p',true);
  PrnWordSave;
end;

源代码如下：

//Word打印（声明部分）
  wDoc,wApp:Variant;
  function PrnWordBegin(tempDoc,docName:String):boolean;
  function PrnWordReplace(docText,newText:String;bSimpleReplace:boolean=false):boolean;
  function PrnWordInsert(lineText:String;bNewLine:boolean=true):boolean;overload;
  function PrnWordInsert(var imgInsert:TImage;sBookMark:String=''):boolean;overload;
  function PrnWordInsert(var chartInsert:TChart;sBookMark:String=''):boolean;overload;
  function PrnWordTable(var dbG:TDBGridEh;sBookMark:String=''):boolean;
  procedure PrnWordSave;
  procedure PrnWordEnd;

//Word打印（实现部分）
{
功能：基于模板文件tempDoc新建目标文件docName并打开文件
}
function PrnWordBegin(tempDoc,docName:String):boolean;
begin
result:=false;
//复制模版
if tempDoc<>'' then
  if not shFileCopy(tempDoc,docName) then exit;
//连接Word
try
  wApp:=CreateOleObject('Word.Application');
except
  guiInfo('请先安装 Microsoft Word 。');
  exit;
end;
try
  //打开
  if tempDoc='' then
  begin
    //创建新文档
    wDoc:=wApp.Document.Add;
    wDoc.SaveAs(docName);
  end else begin
    //打开模版
    wDoc:=wApp.Documents.Open(docName);
  end;
except
  guiInfo('打开模版失败，请检查模版是否正确。');
  wApp.Quit;
  exit;
end;
wApp.Visible:=true;
result:=true;
end;

{
功能：使用newText替换docText内容
bSimpleReplace：true时仅做简单的替换，false时对新文本进行换行处理
}
function PrnWordReplace(docText,newText:String;bSimpleReplace:boolean=false):boolean;
var i:Integer;
begin
if bSimpleReplace then
begin
  //简单处理，直接执行替换操作
try
  wApp.Selection.Find.ClearFormatting;
  wApp.Selection.Find.Replacement.ClearFormatting;
  wApp.Selection.Find.Text := docText;
  wApp.Selection.Find.Replacement.Text :=newText;
  wApp.Selection.Find.Forward := True;
  wApp.Selection.Find.Wrap := wdFindContinue;
  wApp.Selection.Find.Format := False;
  wApp.Selection.Find.MatchCase := False;
  wApp.Selection.Find.MatchWholeWord := true;
  wApp.Selection.Find.MatchByte := True;
  wApp.Selection.Find.MatchWildcards := False;
  wApp.Selection.Find.MatchSoundsLike := False;
  wApp.Selection.Find.MatchAllWordForms := False;
  wApp.Selection.Find.Execute(Replace:=wdReplaceAll);
  result:=true;
except
  result:=false;
end;
  exit;
end;

//自动分行
reWord.Lines.Clear;
reWord.Lines.Add(newText);
try
  //定位到要替换的位置的后面
  wApp.Selection.Find.ClearFormatting;
  wApp.Selection.Find.Text := docText;
  wApp.Selection.Find.Replacement.Text := '';
  wApp.Selection.Find.Forward := True;
  wApp.Selection.Find.Wrap := wdFindContinue;
  wApp.Selection.Find.Format := False;
  wApp.Selection.Find.MatchCase := False;
  wApp.Selection.Find.MatchWholeWord := False;
  wApp.Selection.Find.MatchByte := True;
  wApp.Selection.Find.MatchWildcards := False;
  wApp.Selection.Find.MatchSoundsLike := False;
  wApp.Selection.Find.MatchAllWordForms := False;
  wApp.Selection.Find.Execute;
  wApp.Selection.MoveRight(wdCharacter,1);

  //开始逐行插入
  for i:=0 to reWord.Lines.Count-1 Do
  begin
    //插入当前行
    wApp.Selection.InsertAfter(reWord.Lines[i]);
    //除最后一行外，自动加入新行
    if i<reWord.Lines.Count-1 then
      wApp.Selection.InsertAfter(#13);
  end;

  //删除替换位标
  wApp.Selection.Find.ClearFormatting;
  wApp.Selection.Find.Replacement.ClearFormatting;
  wApp.Selection.Find.Text := docText;
  wApp.Selection.Find.Replacement.Text := '';
  wApp.Selection.Find.Forward := True;
  wApp.Selection.Find.Wrap := wdFindContinue;
  wApp.Selection.Find.Format := False;
  wApp.Selection.Find.MatchCase := False;
  wApp.Selection.Find.MatchWholeWord := true;
  wApp.Selection.Find.MatchByte := True;
  wApp.Selection.Find.MatchWildcards := False;
  wApp.Selection.Find.MatchSoundsLike := False;
  wApp.Selection.Find.MatchAllWordForms := False;
  wApp.Selection.Find.Execute(Replace:=wdReplaceAll);
  result:=true;
except
  result:=false;
end;
end;

{
功能：打印TDBGridEh当前显示的内容
基于TDBGridEh控件的格式和内容，自动在文档中的sBookMark书签处生成Word表格
目前能够支持单元格对齐、多行标题（两行）、底部合计等特性
sBookMark：Word中要插入表格的书签名称
}
function PrnWordTable(var dbG:TDBGridEh;sBookMark:String=''):boolean;
var iCol,iLine,i,j,k:Integer;
  wTable,wRange:Variant;
  iRangeEnd:longint;
  iGridLine,iTitleLine:Integer;
  getTextText:String;getTextDisplay:boolean;
  titleList:TStringList;