超难问题：怎样用delphi新建一个word文档，然后插入内容，并对特定的内容设置不同的字体，然后给word文件取一个文件名保存(100分)

如题所述

给一篇你参考一下吧
//这是我做项目过程中自己做的几个函数，见到大家都在问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);
//除最后一行外，自动加入新行
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;
titleSplit, titleCol: Integer;
lastTitleSplit, SubTitle: Integer;
lastTitle : string;
begin
result := false;
try
//计算表格的列数（不包括隐藏的列）
iTitleLine := 1; //始终默认为1
iCol := 0;
for i := 0 to dbG.Columns.Count - 1 do
begin
if dbG.Columns.Visible then
begin
iCol := iCol + 1;
end;
end;
//计算表格的行数（不包括隐藏的列）
if dbG.DataSource.DataSet.Active then
iLine := dbG.DataSource.DataSet.RecordCount
else
iLine := 0;
iGridLine := iLine + iTitleLine + dbG.FooterRowCount;
//定位插入点
if sBookMark = '' then
begin
//在文档末尾
iRangeEnd := wDoc.Range.End - 1;
if iRangeEnd < 0 then iRangeEnd := 0;
wRange := wDoc.Range(iRangeEnd, iRangeEnd);
end
else
begin
//在书签处
wRange := wDoc.Range.goto(wdGoToBookmark, , , sBookMark);
end;
wTable := wDoc.Tables.Add(wRange, iGridLine, iCol);
wTable.Columns.AutoFit;
//标题行
k := 1;
for j := 1 to dbG.Columns.Count do
begin
if dbG.Columns[j - 1].Visible then
begin
if dbG.UseMultiTitle then
begin
titleList := strSplit(dbG.Columns[j - 1].Title.Caption, '|');
wTable.Cell(1, k).Range.InsertAfter(titleList.Strings[0]);
end
else
wTable.Cell(1, k).Range.InsertAfter(dbG.Columns[j - 1].Title.Caption);
//设置单元格对齐方式
if dbG.Columns[j - 1].Title.Alignment = taCenter then
wTable.Cell(1, k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphCenter
else
if dbG.Columns[j - 1].Title.Alignment = taRightJustify then
wTable.Cell(1, k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphRight
else
if dbG.Columns[j - 1].Title.Alignment = taLeftJustify then
wTable.Cell(1, k).Range.ParagraphFormat.Alignment
:= wdAlignParagraphJustify;
k := k + 1;
end;
end;
//填写每一行
if iLine > 0 then
begin
dbG.DataSource.dataset.DisableControls;
dbG.DataSource.DataSet.First;
for i := 1 to iLine do
begin
k := 1;
for j := 1 to dbG.Columns.Count do
begin
if dbG.Columns[j - 1].Visible then
begin
if dbG.Columns[j - 1].FieldName <> '' then
//避免由于空列而出错
begin
//如果该列有自己的格式化显示函数，则调用显示函数获取显示串
getTextText := '';
if
Assigned(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j -
1].FieldName).OnGetText) then
begin
dbG.DataSource.DataSet.FieldByName(dbG.Columns[j -
1].FieldName).OnGetText(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j - 1].FieldName), getTextText, getTextDisplay);
wTable.Cell(i + iTitleLine,k).Range.InsertAfter(getTextText);
end
else
begin
//使用数据库内容显示
wTable.Cell(i + iTitleLine,
k).Range.InsertAfter(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j - 1].FieldName).AsString);
end;
end;
//设置单元格对齐方式
if dbG.Columns[j - 1].Alignment = taCenter then
wTable.Cell(i + iTitleLine,
k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphCenter
else
if dbG.Columns[j - 1].Alignment = taRightJustify then
wTable.Cell(i + iTitleLine,
k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphRight
else
if dbG.Columns[j - 1].Alignment = taLeftJustify then
wTable.Cell(i + iTitleLine,
k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphJustify;
k := k + 1;
end;
end;
dbG.DataSource.DataSet.Next;
end;
end;
//结尾行
for i := 1 to dbG.FooterRowCount do
begin
k := 1;
for j := 1 to dbG.Columns.Count do
begin
if dbG.Columns[j - 1].Visible then
begin
wTable.Cell(iLine + 1 + i,
k).Range.InsertAfter(dbG.GetFooterValue(i - 1,
dbG.Columns[j - 1]));
//设置单元格对齐方式
if dbG.Columns[j - 1].Footer.Alignment = taCenter then
wTable.Cell(iLine + 1 + i,
k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphCenter
else
if dbG.Columns[j - 1].Footer.Alignment =
taRightJustify then
wTable.Cell(iLine + 1 + i,
k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphRight
else
if dbG.Columns[j - 1].Footer.Alignment =
taLeftJustify then
wTable.Cell(iLine + 1 + i,
k).Range.ParagraphFormat.Alignment :=
wdAlignParagraphJustify;
k := k + 1;
end;
end;
end;
//处理多行标题
if dbG.UseMultiTitle then
begin
//先分割单元格，再逐个填入第二行
k := 1;
titleCol := 1;
lastTitleSplit := 1;
SubTitle := 0;
lastTitle := '';
for j := 1 to dbG.Columns.Count do
begin
if dbG.Columns[j - 1].Visible then
begin
titleList := strSplit(dbG.Columns[j -
1].Title.Caption,
'|');

if titleList.Count > 1 then
begin
//处理第二行以上的内容
wTable.Cell(1, k -
SubTitle).Range.Cells.Split(titleList.Count, 1,
false);
for titleSplit := 1 to titleList.Count - 1 do
begin
wTable.Cell(titleSplit + 1,
titleCol).Range.InsertAfter(titleList.Strings[titleSplit]);
end;
titleCol := titleCol + 1;
//处理第一行合并
if (lastTitleSplit = titleList.Count) and (lastTitle
= titleList.Strings[0]) then
begin
//内容相同时，合并单元格
wTable.Cell(1, k - SubTitle).Range.Copy;
wRange := wDoc.Range(wTable.Cell(1, k - SubTitle -
1).Range.Start, wTable.Cell(1, k -
SubTitle).Range.End);
wRange.Cells.Merge;
wRange.Paste;
SubTitle := SubTitle + 1;
end;
end;
lastTitle := titleList.Strings[0];
lastTitleSplit := titleList.Count;
titleList.Clear;
titleList.Free;
k := k + 1;
end;
end;
end;
//自动调整表格
wTable.AutoFitBehavior(1);
//根据内容自动调整表格wdAutoFitContent
wTable.AutoFitBehavior(2);
//根据窗口自动调整表格wdAutoFitWindow
result := true;
except
result := false;
end;
try
dbG.DataSource.dataset.EnableControls;
except
end;
end;

{
功能：在Word文件中插入文本（能够自动进行换行处理）
lineText：要插入的文本
bNewLine：true时新起一行，false时在当前行插入
}

function PrnWordInsert(lineText: string; bNewLine: boolean =
true): boolean;
var
i : Integer;
begin
try
if bNewLine then
wDoc.Range.InsertAfter(#13);
//自动分行
reWord.Lines.Clear;
reWord.Lines.Add(lineText);
//开始逐行插入
for i := 0 to reWord.Lines.Count - 1 do
begin
//插入当前行
wDoc.Range.InsertAfter(reWord.Lines);
//除最后一行外，自动加入新行
if i < reWord.Lines.Count - 1 then
wDoc.Range.InsertAfter(#13);
end;
result := true;
except
result := false;
end;
end;
{
功能：在Word文件的sBookMark书签处插入TImage控件包含的图片
}

function PrnWordInsert(var imgInsert: TImage; sBookMark: string
= ''): boolean;
var
wRange : Variant;
iRangeEnd : Integer;
begin
try
if sBookMark = '' then
begin
//在文档末尾
iRangeEnd := wDoc.Range.End - 1;
if iRangeEnd < 0 then iRangeEnd := 0;
wRange := wDoc.Range(iRangeEnd, iRangeEnd);
end
else
begin
//在书签处
wRange := wDoc.Range.goto(wdGoToBookmark, , , sBookMark);
end;
if imgInsert.Picture.Graphic <> nil then
begin
Clipboard.Assign(imgInsert.Picture);
wRange.Paste;
end
else
begin
wRange.InsertAfter('照片');
end;
result := true;
except
result := false;
end;
end;

{
功能：在书签sBookMark处插入TChart控件包含的图表
}

function PrnWordInsert(var chartInsert: TChart; sBookMark: string
= ''): boolean;
var
wRange : Variant;
iRangeEnd : Integer;
begin
try
if sBookMark = '' then
begin
//在文档末尾
iRangeEnd := wDoc.Range.End - 1;
if iRangeEnd < 0 then iRangeEnd := 0;
wRange := wDoc.Range(iRangeEnd, iRangeEnd);
end
else
begin
//在书签处
wRange := wDoc.Range.goto(wdGoToBookmark, , , sBookMark);
end;
chartInsert.CopyToClipboardBitmap;
wRange.Paste;
result := true;
except
result := false;
end;
end;

{
功能：保存Word文件
}
procedure PrnWordSave;
begin
try
wDoc.Save;
except
end;
end;
{
功能：关闭Word文件
}
procedure PrnWordEnd;
begin
try
wDoc.Save;
wDoc.Close;
wApp.Quit;
except

end;
end;
//附：shFileCopy源代码
{
功能：安全的复制文件
srcFile，destFile：源文件和目标文件
bDelDest：如果目标文件已经存在，是否覆盖
返回值：true成功，false失败
}
function shFileCopy(srcFile, destFile: string; bDelDest: boolean
= true): boolean;
begin
result := false;
if not FileExists(srcFile) then
begin
guiInfo('源文件不存在，不能复制。' + #10#13 + srcFile);
exit;
end;
if srcFile = destFile then
begin
guiInfo('源文件和目标文件相同，不能复制。');
exit;
end;
if FileExists(destFile) then
begin
if not bDelDest then
begin
guiInfo('目标文件已经存在，不能复制。' + #10#13 +
destFile);
exit;
end;
FileSetAttr(destFile, FileGetAttr(destFile) and not
$00000001);
if not DeleteFile(PChar(destFile)) then
begin
guiInfo('目标文件已经存在，并且不能被删除，复制失败。' +
#10#13 + destFile);
exit;
end;
end;
if not CopyFileTo(srcFile, destFile) then
begin
guiInfo('发生未知的错误，复制文件失败。');
exit;
end;
//目标文件去掉只读属性
FileSetAttr(destFile, FileGetAttr(destFile) and not
$00000001);
result := true;
end;

//附：guiInfo源代码

{
功能：封装了各种性质的提示框
sMsg：要提示的消息
}

procedure guiInfo(sMsg: string);
begin
MessageDlg(sMsg, mtInformation, [mbOK], 0);
end;

最关键的设置特定内容的字体没有呀

WORD帮助里面有详细说明的，是哪个文件不记得了。摘抄一段代码:
var
WApp: TWordApplication;
begin
WApp.Selection.Font.Name :='黑体';
WApp.Selection.Font.Size := 16;
WApp.Selection.ParagraphFormat.Reset;
WApp.Selection.ParagraphFormat.Alignment := wdAlignParagraphLeft;
WApp.Selection.TypeText(ADO1.Fields[2].Text);
WApp.Selection.ParagraphFormat.FirstLineIndent :=0;
//WApp1.Selection.TypeParagraph;
WApp.Selection.ParagraphFormat.Reset;
WApp.Selection.TypeParagraph;
WApp.Selection.Font.Name := '宋体';
WApp.Selection.Font.Size :=9;
WApp.Selection.ParagraphFormat.Alignment := wdAlignParagraphLeft;
WApp.Selection.ParagraphFormat.FirstLineIndent :=16;
WApp.Selection.TypeText(ADO1.Fields[3].asstring);
WApp.Selection.TypeParagraph;
//WApp1.Selection.TypeParagraph;

procedure TForm1.Button1Click(Sender: TObject);
var
word_doc : variant;
i : integer;
begin
try
word_doc :=createOleObject('word.application');
word_doc.filenew('Normal');
except
showMessage('无法启动Ms Word');
exit;
end;
word_doc.insert('aaaaaaaa bbbbbbbb cccccccc'+#13);
word_doc.insert('dddddddd eeeeeeee ffffffff'+#13);
word_doc.filesaveas('c:/eee.doc');
end;

我运行上面的代码，虽然可以创建并保存word文件，但是打开word文件时却提示说此文件
被锁定和只读，不知我的代码有何错误。
还有就是,我想把bbbbbbbb和eeeeeeee用delphi实现选定，然后设置一个不同的字体，该如何实现？

word_doc.visible:=true;

word_doc.visible:=true;
这一句要如何使用？
我加上这一句代码后，无法通过编译。

使用Servers控件版中的WordDocument、WordApplication等，可轻松实现，非常简单。

你的saveas后面文件没有关闭外部再打开就是只读的

如saida所说，还是用控件更好一点。
如果输出到word要求的格式较高的话，可以参考《电脑报》49期我的一篇文章。
我不知道我现在有没有权力在DFW拿出此稿：（

DFW上有一篇很好的东西介绍过一个很方便的办法，我一时检索不到。反而找到当时看过后自己写的备忘笔记。希望对你有助。[]
希望热心人帮检索一下该文，讲的是在WORD里用特殊字符代表数据库字段，然后再替换实现。

以下是我的读后备忘：

使用WORD实现含有数据库内容的复杂版面设计
读后备忘笔记：
1、 用途：Delphi（哪怕加上FastReport等第三方控件）在设计复杂版面时（例如控制行距、字距等）较为吃力，使用word 能够排出各种复杂版面，在word文件需要数据的地方写入数据即可。
2、 VBA: 查看WORD关于宏的帮助。自己录制一段宏，查看其生成的代码。尤其是录制这样的一段宏：将文件中所有“@@我的数据”（数据库字段所在位置的标志，替换成功后保持原排版信息），替换成“看，替换成功了！”（模拟数据库字段的内容）的宏，就理解如何将数据库字段内容巧妙地插入该插入的位置中去了。
3、 Servers组件中跟Word有关的Wordapplication等控件要熟。

很感谢大家的参与， 能不能贴出代码来呀

你的信箱是多少我有源代码，我发给你

我的邮箱是toupiao333@yahoo.com.cn