• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    迪恩网络公众号

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

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

(*

By 闫磊 编写 2004.09.06 Email:[email protected] [email protected]

*)

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:[email protected] [email protected]

*)

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人参与评论

请发表评论

全部评论

专题导读
上一篇:
MATLAB中的单相与三相dq变换模块发布时间:2022-07-18
下一篇:
matlab的legend用法发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

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