Delphi与Word(一) 合并Word 表格中单元格

//合并Word 表格中单元格
procedure mergeWordCell;
var WordApp: TWordApplication;
    WordDoc: TWordDocument;
    DocInx,oFileName,CfCversions,oReadOnly,AddToRctFiles,PswDocument,
    PswTemplate,oRevert,WPswDocument,WPswTemplate,oFormat: OleVariant;
    i,iRow,iCol:integer;
    myCell:Cell;
    myRow:Row;
begin
  memo1.Lines.Clear ;

    // ===== 创建对象 =====
    if not Assigned(WordApp) then                         
    begin
      WordApp:= TWordApplication.Create(nil);
      WordApp.Visible := false;
    end;
    if not Assigned(WordDoc) then
      WordDoc:= TWordDocument.Create(nil);
  try
    DocInx:=1;
    oFileName := 'd:/test.doc';
    oReadOnly:=true;
    CfCversions := EmptyParam;
    AddToRctFiles:= EmptyParam;
    PswDocument:= EmptyParam;
    PswTemplate:= EmptyParam;
    oRevert:= EmptyParam;
    WPswDocument:= EmptyParam;
    WPswTemplate:= EmptyParam;
    oFormat:= EmptyParam;    
    // ===== 打开文件 =====                        
    WordApp.Documents.open(oFileName,CfCversions,oReadOnly,AddToRctFiles,
       PswDocument,PswTemplate,oRevert,WPswDocument,WPswTemplate,oFormat);
    // ===== 关联文件 =====
    WordDoc.ConnectTo(WordApp.Documents.Item(DocInx));


    //合并第一、二列
        iStart:=WordDoc.Tables.Item(i).Cell(1,1).Range.Start;
        myCol:= WordDoc.Tables.Item(i).Columns.Item(2);
        iEnd:=myCol.Cells.Item(myCol.Cells.Count).Range.End_;
        myRange:=WordDoc.Range;
        myRange.Start:=iStart;
        myRange.End_ :=iEnd;
        myRange.Cells.Merge;

  finally
    if Assigned(WordDoc) then     // ===== 关闭文件 =====
    begin
      WordDoc.Close;
      WordDoc.Disconnect;
      WordDoc.Destroy;
      WordDoc := nil;
    end;
    if Assigned(WordApp) then      // ===== 关闭Word =====
    begin
      WordApp.Quit;
      WordApp.Disconnect;
      WordApp.Destroy;
      WordApp := nil;
    end;
  end;
end;

 

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
//文件操作部分起 //拷贝一个文件,封装CopyFile procedure FileCopyFile(const sSrcFile, sDstFile: string); //给定路径复制文件到同一目录下 bRecursive:true所有 procedure FileCopyDirectory(sDir, tDir: string; bRecursive: Boolean);overload; //给定路径原样复制文件 ,自编 procedure FileCopyDirectory(sDir, tDir: string);overload; //给定路径原样复制文件 ,用WinAPI ,若原目录下有相同文件则再生成一个 procedure FileCopyDirectory(sDir, tDir:string;AHandle:Thandle);overload; //移动文件夹 procedure FileMoveDirectory(sDir, tDir:string;AHandle:Thandle); //删除给定路径及以下的所有路径和文件 procedure FileDeleteDirectory(sDir: string);overload; //删除给定路径及以下的所有路径和文件 用WinApi procedure FileDeleteDirectory(AHandle: THandle;const ADirName: string);overload; //删除给定路径及以下的所有路径和文件 到回收站 procedure FileDeleteDirectoryToCycle(AHandle: THandle;const ADirName: string); //取得指定文件的大小 function FileGetFileSize(const Filename: string): DWORD; //在Path下取得唯一FilenameX文件 function FileGetUniqueFileName(const Path: string; Filename: string): string; //取得临时文件 function FileGetTemporaryFileName: string; //取得系统路径 function PathGetSystemPath: string; //取得Windows路径 function PathGetWindowsPath: string; //给定文件名取得在系统目录下的路径,复制时用 function PathSystemDirFile(const Filename: string): string; //给定文件名取得在Windows目录下的路径,复制时用 function PathWindowsDirFile(const Filename: string): string; //给定文件名取得在系统盘下的路径,复制时用 function PathSystemDriveFile(const Filename: string): string; //路径最后有'/'则去'/' function PathWithoutSlash(const Path: string): string; //路径最后没有'/'则加'/' function PathWithSlash(const Path: string): string; //取得两路径的不同部分,条件是前半部分相同 function PathRelativePath(BaseDir, FilePath: string): string; //取得去掉属性的路径,文件名也作为DIR function PathExtractFileNameNoExt(Filename: string): string; //判断两路径是否相等 function PathComparePath(const Path1, Path2: string): Boolean; //取得给定路径的父路径 function PathParentDirectory(Path: string): string; //分割路径,Result=根(如d:)sPath = 除根外的其他部分 function PathGetRootDir(var sPath: string): string; //取得路径最后部分和其他部分 如d:\aa\aa result:=aa sPath:=d:\aa\ function PathGetLeafDir(var sPath: string): string; //取得当前应用程序的路径 function PathExeDir(FileName: string = ''): string; //文件操作部分止 //系统处理起 //提示窗口 procedure MsgBox(const Msg: string); //错误显示窗口 procedure MsgErrBox(const Msg: string); //询问窗口 带'是','否'按钮 function MsgYesNoBox(const Msg: string): Boolean; //询问窗口 带'是','否,'取消'按钮//返回值smbYes,smbNo,smbCancel function MsgYesNoCancelBox(const Msg: string): Integer; //使鼠标变忙和恢复正常 procedure DoBusy(Busy: Boolean); //显示错误信息 procedure ShowLastError(const Msg: string = 'API Error'); //发出错误信息 procedure RaiseLastError(const Msg: string = 'API Error'); //释放Strings连接的相关资源 procedure FreeStringsObjects(SL: TStrings); //系统处理止 //时间处理起 //整数到时间 function TimeT_To_DateTime(TimeT: Longint): TDateTime; //转化为秒 function TimeToSecond(const H, M, S: Integer): Integer; //秒转化 procedure TimeSecondToTime(const secs: Integer; var H, M, S: Word); //秒转化 function TimeSecondToTimeStr(secs: Integer): string; //时间处理止 //控件处理起 //设置控件是否能使用 procedure ConEnableControl(AControl: TControl; Enable: Boolean); //设置控件是否能使用,包子控件 procedure ConEnableChildControls(AControl: TControl; Enable: Boolean); procedure ConEnableClassControl(AControl: TControl; Enable: Boolean; ControlClass: TControlClass); procedure ConFree(aCon: TWinControl);//释放aCon上的控件 //从文件本导入,类似LoadfromFile procedure ConLoadTreeViewFromTextFile(Nodes: TTreeNodes; Filename: string); //存为文本,类似SaveToFile procedure ConSaveTreeViewToTextFile(Nodes: TTreeNodes; Filename: string); //在控件上写文本 procedure ConWriteText(aContr: TControl;sText: string); //控件处理止 //字符串处理起 //取以Delimiters分隔的字符串 bTrail如果为True则把第index个后的也取出来 function StrGetToken(const S: string; index: Integer; bTrail: Boolean = False; Delimiters: TSysCharSet = DEFAULT_DELIMITERS): string; //取以Delimiters分隔的字符串的个数 function StrCountWords(S: string; Delimiters: TSysCharSet = DEFAULT_DELIMITERS): Integer; //用NewToken替换S所有Token bCaseSensitive:=true大小写敏感 function StrReplaceString(var S: string; const Token, NewToken: string; bCaseSensitive: Boolean): Boolean; //从第Index个起以Substr替换Count个字符 procedure StrSimple_ReplaceString(var S: string; const Substr: string; index, Count: Integer); //去掉S的回车返行符 procedure StrTruncateCRLF(var S: string); //判定S是否以回车返行符结束 function StrIsContainingCRLF(const S: string): Boolean; //把SL的各项数据转化为以Delimiter分隔的Str function StrCompositeStrings(SL: TStrings; const Delimiter: string): string; //封装TStrings的LoadFromFile function StrSafeLoadStrings(SL: TStrings; const Filename: string): Boolean; //封装TStrings的SaveToFile procedure StrSafeSaveStrings(SL: TStrings; const Filename: string); //字符串处理止 //字体处理起 procedure StringToFont(sFont: string; Font: TFont; bIncludeColor: Boolean = True); function FontToString(Font: TFont; bIncludeColor: Boolean = True): string; //字体处理止 //网络起 //判定是否在线 function NetJudgeOnline:boolean; //得到本机的局域网Ip地址 Function NetGetLocalIp(var LocalIp:string): Boolean; //通过Ip返回机器名 Function NetGetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ; //获取网络SQLServer列表 Function NetGetSQLServerList(var List: Tstringlist): Boolean; //获取网络的所有网络类型 Function NetGetNetList(var List: Tstringlist): Boolean; //获取网络的工作组 Function NetGetGroupList(var List: TStringList): Boolean; //获取工作组所有计算机 Function NetGetUsers(GroupName: string; var List: TStringList): Boolean; //获取网络的资源 Function NetGetUserResource(IpAddr: string; var List: TStringList): Boolean; //映射网络驱动器 Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean; //检测网络状态 Function NetCheckNet(IpAddr:string): Boolean; //检测机器是否登入网络 Function NetCheckMacAttachNet: Boolean; //判断Ip协议有没有安装 这个函数有问题 Function NetIsIPInstalled : boolean; //检测机器是否上网 Function NetInternetConnected: Boolean; //网络止 //窗口起 function FormCreateProcessFrm(MsgTitle: string):TForm; //窗口止 //EMail起 function CheckMailAddress(Text: string): boolean; //EMail止

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值