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

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

(*
 
By 闫磊 编写 2004.09.06 Email:[e-mail] [e-mail]
 
*)
 
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.