delphi操作word基类,插入表格,分页符,日期,页码,替换,图片

原作者: [db:作者] 来自: [db:来源] 收藏邀请

unit utMyword;

(*

By 闫磊 编写 2004.09.06 Email:landgis@126.com yanleigis@21cn.com

*)

interface

uses word2000, ActiveX, Variants, Dialogs, SysUtils;

type

    TMyWord = class(TObject)

    private

    FWord: TWordApplication;        //word对象

    FDoc: TWordDocument;            //文档对象

    procedure connectword();

    public

    //换行

    procedure AddReturn();

    //设置字体

    procedure SetFont(FontName: string; FontSize: Integer;

    FontBold: Boolean = False; FontUnderline: Boolean = False);

    //插入表格

    function AddTable(Col, Row: Integer): Table;

    //设置背景色

    procedure SetTableBack(BackColor: ToleEnum);

    //鼠标下移

    procedure MoveDown(num: Integer = 1);

    //选择下移

    procedure SelectDown(num: Integer = 1);

    //鼠标上移

    procedure Moveup();

    //鼠标右移

    procedure MoveRight(num: Integer = 1);

    //选择右移

    procedure SelectRight(num: Integer = 1);

    //写字

    procedure WriteText(Text: string);

    //按样式插入一行记录

    //如AddLine "备注","正文"

    //AddLine 'kk',"标题 1"

    procedure AddLine(S: string; PStyle: olevariant);

    procedure AlignLine(Align: ToleEnum);

    //插入分页符

    procedure insertPage();

    //插入插入页码

    procedure insertPagenum();

    //插入日期

    procedure insertDate();

    //设置表格一列宽度

    procedure SetTable(PTable: Table; ColumnIdx: Integer; Width: Integer);

    //设置表格一列高度

    procedure SetTableheight(PTable: Table; RowIdx: Integer; height:

    Integer);

    //插入目录

    procedure InsertContents();

    //创立书签

    procedure createBookMark(BookMarkName: string);

    //移动到标签

    procedure GotoBookMark(BookMarkName: string);

    //粘贴

    procedure paste();

    //替换

    procedure Replace(Source, Target: string);

    //保存

    procedure Save(FileName: string);

    //插入图片

    procedure AddPicture(FileName: string);

    //移到最后

    procedure MoveEnd();

    //合并

    procedure CellsMerge();

    constructor Create;

    destructor Destroy; override;

end;

 

//function Myword: TMyWord;

implementation

//var

//    FMyWord: TMyWord;

{function Myword: TMyWord;

begin

    if FMyWord = nil then

    begin

        FMyWord := TMyWord.Create;

    end;

 

    Result := FMyWord;

end;

 

}

constructor TMyWord.Create();

begin

    inherited Create;

    connectword();

    //

end;

 

procedure TMyWord.connectword();

var

B: Boolean;

begin

    B := False;

    if (FWord = nil) then

    B := True

    else

    begin

        try

        FDoc.Activate;

        except

            B := True;

        end;

 

    end;

 

    if not B then Exit;

    FWord := TWordApplication.Create(nil); //word对象

    FDoc := TWordDocument.Create(nil);  //文档对象

    FWord.Connect;

    FDoc.Activate;

    FWord.Visible := True;

end;

 

destructor TMyWord.Destroy;

begin

    //

    //FDoc.SaveAs('c:/1.doc');

    FDoc.Free;

    FWord.Disconnect;

    //退出一定退出word,by yl 2005.2.2

    //FWord.Quit;

    //FWord.Free;

    inherited Destroy;

end;

 

procedure TMyWord.AddReturn();

begin

    try

    FWord.Selection.TypeParagraph;

    except

        AddReturn();

    end;

 

end;

 

procedure TMyWord.SetFont(FontName: string; FontSize: Integer; FontBold:

Boolean

= False; FontUnderline: Boolean = False);

begin

    try

    //connectword();

    FWord.Selection.Font.Name := FontName;

    FWord.Selection.Font.Size := FontSize;

    if FontBold then

    FWord.Selection.Font.Bold := wdToggle;

    if FontUnderline then

    FWord.Selection.Font.Underline := wdUnderlineSingle;

    except

        SetFont(FontName, FontSize, FontBold, FontUnderline);

    end;

 

end;

 

//插入表格

function TMyWord.AddTable(Col, Row: Integer): Table;

var

DefaultTable: olevariant;

begin

    try

    //connectword();

    DefaultTable := 1;

    Result := FDoc.Tables.Add(FWord.Selection.Range, Row, Col, DefaultTable,

    EmptyParam);

    except

        ShowMessage(Format('列%d,行%d', [Col, Row]));

        AddTable(Col, Row);

    end;

 

end;

 

//设置背景色

procedure TMyWord.SetTableBack(BackColor: ToleEnum);

begin

    try

    //connectword();

    FWord.Selection.Cells.Shading.BackgroundPatternColor := BackColor;

    except

        SetTableBack(BackColor);

    end;

 

end;

 

//选择下移

procedure TMyWord.SelectDown(num: Integer = 1);

var

Unit_: olevariant;

Count: olevariant;

Extend: olevariant;

begin

    try

    //connectword();

    Count := num;

    Unit_ := wdLine;

    Extend := wdExtend;

    FWord.Selection.MoveDown(Unit_, Count, Extend);

    except

        MoveDown();

    end;

 

end;

 

//鼠标下移

procedure TMyWord.MoveDown(num: Integer = 1);

var

Unit_: olevariant;

Count: olevariant;

Extend: olevariant;

begin

    try

    //connectword();

    Count := num;

    Unit_ := wdLine;

    FWord.Selection.MoveDown(Unit_, Count, Extend);

    except

        MoveDown();

    end;

 

end;

 

//鼠标上移

procedure TMyWord.Moveup();

var

Unit_: olevariant;

Count: olevariant;

Extend: olevariant;

begin

    Unit_ := wdLine;

    Count := 1;

    FWord.Selection.Moveup(Unit_, Count, Extend);

end;

 

//选择右移

procedure TMyWord.SelectRight(num: Integer = 1);

var

Unit_: olevariant;

Count: olevariant;

Extend: olevariant;

begin

    try

    //connectword();

    Unit_ := wdCharacter;

    Count := num;

    Extend := wdExtend;

    FWord.Selection.MoveRight(Unit_, Count, Extend);

    except

        MoveRight();

    end;

 

end;

 

//鼠标右移

procedure TMyWord.MoveRight(num: Integer = 1);

var

Unit_: olevariant;

Count: olevariant;

Extend: olevariant;

begin

    try

    //connectword();

    Unit_ := wdCell;

    Count := num;

    FWord.Selection.MoveRight(Unit_, Count, Extend);

    except

        MoveRight();

    end;

 

end;

 

//写字

procedure TMyWord.WriteText(Text: string);

begin

    try

    //connectword();

    FWord.Selection.TypeText(Text);

    except                              //防止呼叫失败

        WriteText(Text);

    end;

 

end;

 

//按样式插入一行记录

//如AddLine "备注","正文"

//AddLine 'kk',"标题 1"

procedure TMyWord.AddLine(S: string; PStyle: olevariant);

procedure SetStyle(PStyle: olevariant);

var

outStyle: Style;

v: olevariant;

begin

    outStyle := FWord.ActiveDocument.Styles.Item(PStyle);

    v := outStyle;

    FWord.Selection.Set_Style(v);

end;

 

begin

    WriteText(S);                       //加入一行

    try

    SetStyle(PStyle);

    except

        SetStyle(PStyle);

    end;

 

end;

 

procedure TMyWord.AlignLine(Align: ToleEnum);

begin

    FWord.Selection.ParagraphFormat.Alignment := Align;

end;

 

//插入分页符

procedure TMyWord.insertPage();

var

_Type: olevariant;

begin

    _Type := 7;

    FWord.Selection.InsertBreak(_Type);

end;

 

//插入日期

procedure TMyWord.insertDate();

var

DateTimeFormat: olevariant;

InsertAsField: olevariant;

InsertAsFullWidth: olevariant;

DateLanguage: olevariant;

CalendarType: olevariant;

begin

    try

    InsertAsField := False;

    InsertAsFullWidth := False;

    DateTimeFormat := 'yyyy''年''M''月''d''日''';

    DateLanguage := wdSimplifiedChinese;

    CalendarType := wdCalendarWestern;

    FWord.Selection.InsertDateTime(DateTimeFormat, InsertAsField,

    InsertAsFullWidth, DateLanguage, CalendarType);

    except

        insertDate();

    end;

 

end;

 

//插入页码

procedure TMyWord.insertPagenum();

var

PSection: Section;

PageNumberAlignment: olevariant;

FirstPage: olevariant;

begin

    PSection := FWord.Selection.Sections.Item(1);

    PageNumberAlignment := 1;           //中间

    FirstPage := True;

    PSection.Footers.Item(wdHeaderFooterPrimary).PageNumbers.Add(PageNumberAlignment, FirstPage);

end;

 

//设置表格一列高度

procedure TMyWord.SetTableheight(PTable: Table; RowIdx: Integer; height:

Integer);

var

Prow: Row;

begin

    Prow := PTable.Rows.Item(RowIdx);

    Prow.SetHeight(height, wdAdjustNone);

end;

 

//设置表格一列宽度

procedure TMyWord.SetTable(PTable: Table; ColumnIdx: Integer; Width:

Integer);

begin

    PTable.Columns.Item(ColumnIdx).SetWidth(Width, wdAdjustNone);

end;

 

//插入目录

procedure TMyWord.InsertContents();

var

pRange: Range;

UseHeadingStyles: olevariant;

UpperHeadingLevel: olevariant;

LowerHeadingLevel: olevariant;

UseFields: olevariant;

TableID: olevariant;

RightAlignPageNumbers: olevariant;

IncludePageNumbers: olevariant;

AddedStyles: olevariant; UseHyperlinks: olevariant;

HidePageNumbersInWeb: olevariant;

begin

    with FWord.ActiveDocument do

    begin

        pRange := FWord.Selection.Range;

        RightAlignPageNumbers := True;

        UseHeadingStyles := True;

        UpperHeadingLevel := 1;

        LowerHeadingLevel := 3;

        IncludePageNumbers := True;

        UseHyperlinks := True;

        HidePageNumbersInWeb := True;

        TablesOfContents.Add(pRange, UseHeadingStyles,

        UpperHeadingLevel,

        LowerHeadingLevel,

        UseFields,

        TableID,

        RightAlignPageNumbers,

        IncludePageNumbers,

        AddedStyles, UseHyperlinks,

        HidePageNumbersInWeb);

        TablesOfContents.Item(1).TabLeader := wdTabLeaderDots;

        TablesOfContents.Format := wdIndexIndent;

    end;

 

end;

 

//创立书签

procedure TMyWord.createBookMark(BookMarkName: string);

var

pRange: olevariant;

begin

    pRange := FWord.Selection.Range;

    with FWord.ActiveDocument.Bookmarks do

    begin

        Add(BookMarkName, pRange);

        DefaultSorting := wdSortByName;

        ShowHidden := False;

    end;

 

end;

 

//移动到标签

procedure TMyWord.GotoBookMark(BookMarkName: string);

var

What: olevariant;

Which: olevariant;

Count: olevariant;

Name: olevariant;

begin

    What := wdGoToBookmark;

    Name := 'BEGIN';

    FWord.Selection.GoTo_(What,

    Which,

    Count,

    Name)

end;

 

//粘贴

procedure TMyWord.paste();

begin

    FWord.Selection.paste;

end;

 

//替换

procedure TMyWord.Replace(Source, Target: string);

var

FindText: olevariant;

PWrap: olevariant;

ReplaceWith: olevariant;

Replace: olevariant;

begin

    FWord.Selection.Find.ClearFormatting;

    FWord.Selection.Find.Replacement.ClearFormatting;

    FindText := Source;

    PWrap := wdFindContinue;

    ReplaceWith := Target;

    Replace := wdReplaceAll;

    with FWord.Selection.Find do

    begin

        {Text := source;

        Replacement.Text := Target;

        forward := True;

        Wrap := wdFindContinue;

        Format := False;

        MatchCase := False;

        MatchWholeWord := False;

        MatchByte := True;

        MatchWildcards := False;

        MatchSoundsLike := False;

        MatchAllWordForms := False;

        }

        Execute(FindText, EmptyParam, EmptyParam, EmptyParam, EmptyParam,

        EmptyParam,

        EmptyParam, PWrap, EmptyParam, ReplaceWith, Replace, EmptyParam,

        EmptyParam, EmptyParam, EmptyParam);

    end;

 

end;

 

//保存

procedure TMyWord.Save(FileName: string);

var

OFilename: olevariant;

begin

    OFilename := FileName;

    FDoc.SaveAs(OFilename);

end;

 

//插入图片

procedure TMyWord.AddPicture(FileName: string);

var

LinkToFile, SaveWithDocument, Range: olevariant;

//index: olevariant;

begin

    //index := 0;

    //Range := FDoc.Bookmarks.Item(index).Range;

    //Range:=Fdoc.GoTo_;

    Range := Self.FWord.Selection.Range;

    LinkToFile := False;

    SaveWithDocument := True;

    FWord.Selection.InlineShapes.AddPicture(FileName, LinkToFile,

    SaveWithDocument, Range)

end;

 

//移到最后

procedure TMyWord.MoveEnd();

var

Unit_: olevariant;

Extend: olevariant;

begin

    Unit_ := wdStory;

    Extend := wdMove;

    FWord.Selection.EndKey(Unit_, Extend);

end;

 

//合并

procedure TMyWord.CellsMerge();

begin

    FWord.Selection.Cells.Merge;

end;

 

initialization

finalization

{ if FMyWord <> nil then

FMyWord.Free;

}

end.

unit utMyword;

By 闫磊编写 2004.09.06 Email:landgis@126.com yanleigis@21cn.com

interface

uses word2000, ActiveX, Variants, Dialogs, SysUtils;

type

TMyWord = class(TObject)

private

FWord: TWordApplication; //word对象

FDoc: TWordDocument; //文档对象

procedure connectword();

public

//换行

procedure AddReturn();

//设置字体

procedure SetFont(FontName: string; FontSize: Integer;

FontBold: Boolean = False; FontUnderline: Boolean = False);

//插入表格

function AddTable(Col, Row: Integer): Table;

//设置背景色

procedure SetTableBack(BackColor: ToleEnum);

//鼠标下移

procedure MoveDown(num: Integer = 1);

//选择下移

procedure SelectDown(num: Integer = 1);

//鼠标上移

procedure Moveup();

//鼠标右移

procedure MoveRight(num: Integer = 1);

//选择右移

procedure SelectRight(num: Integer = 1);

//写字

procedure WriteText(Text: string);

//按样式插入一行记录

//如AddLine "备注","正文"

//AddLine 'kk',"标题 1"

procedure AddLine(S: string; PStyle: olevariant);

procedure AlignLine(Align: ToleEnum);

//插入分页符

procedure insertPage();

//插入插入页码

procedure insertPagenum();

//插入日期

procedure insertDate();

//设置表格一列宽度

procedure SetTable(PTable: Table; ColumnIdx: Integer; Width: Integer);

//设置表格一列高度

procedure SetTableheight(PTable: Table; RowIdx: Integer; height:

Integer);

//插入目录

procedure InsertContents();

//创立书签

procedure createBookMark(BookMarkName: string);

//移动到标签

procedure GotoBookMark(BookMarkName: string);

//粘贴

procedure paste();

//替换

procedure Replace(Source, Target: string);

//保存

procedure Save(FileName: string);

//插入图片

procedure AddPicture(FileName: string);

//移到最后

procedure MoveEnd();

//合并

procedure CellsMerge();

constructor Create;

destructor Destroy; override;

end;

//function Myword: TMyWord;

implementation

//var

// FMyWord: TMyWord;

{function Myword: TMyWord;

begin

if FMyWord = nil then

begin

FMyWord := TMyWord.Create;

end;

Result := FMyWord;

end;

}

constructor TMyWord.Create();

begin

inherited Create;

connectword();

end;

procedure TMyWord.connectword();

var

B: Boolean;

该文章已有0人参与评论
请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

上一篇：
MATLAB中的单相与三相dq变换模块发布时间：2022-07-18
下一篇：
matlab的legend用法发布时间：2022-07-18

热门推荐

More+

android/android-ktx: A set of Kotlin ext

librespeed/speedtest: Self-hosted Speedt

avehtari/BDA_m_demos: Bayesian Data Anal

四维彩超怎么看性别？四维看男孩女孩诀窍

medfreeman/markdown-it-toc-and-anchor: m

热门话题

More+

2022-11-06
剪的笔顺,诠释剪的笔画,认识剪的部首

florent37/ViewAnimator: A fluent Android

2022-08-15

florent37/Shrine-MaterialDesign2: implem

2022-08-17

CVE-2020-36276

2022-09-23

六六分期app的软件客服如何联系？(六六分期

2023-10-27

doraiso/Mastodon

2022-08-18

阅读排行榜

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：9001|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：6521|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：5426|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：5901|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：5777|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：6159|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：5738|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：5210|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：5563|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：4928|2022-11-06

关于我们

创业团队加入我们媒体报道合作伙伴公益事业

产品与服务

寻求合作项目投资干货视频经理人培训招聘代理

解决方案

一站式制造业教育科研行业案例

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）
在线QQ客服

地址：深圳市南山区西丽大学城创智工业园

电邮：jeky_zhao#qq.com

移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap

返回顶部

客服电话

电子邮件

delphi操作word基类,插入表格,分页符,日期,页码,替换,图片

请发表评论

全部评论

上一篇：

下一篇：

android/android-ktx: A set of Kotlin ext

librespeed/speedtest: Self-hosted Speedt

avehtari/BDA_m_demos: Bayesian Data Anal

四维彩超怎么看性别？四维看男孩女孩诀窍

medfreeman/markdown-it-toc-and-anchor: m

剪的笔顺,诠释剪的笔画,认识剪的部首

florent37/ViewAnimator: A fluent Android

florent37/Shrine-MaterialDesign2: implem

CVE-2020-36276

六六分期app的软件客服如何联系？(六六分期

doraiso/Mastodon

关于我们

产品与服务

解决方案

139-2527-9053