[原创]VLSP操作WORD的函数库

NetBee · 发表于 2007-12-11 21:15:00

本帖最后由作者于 2007-12-15 23:45:38 编辑

网上只有操作[shadow=255,red,2]Excel[/shadow]的函数库，却没有操作WORD的。参考EXCEL的，试着写了一些基本的操作：
希望大家来完善：

;;;预加载WORD库
(Defun nbtf-vlDoc-app-Init
(/ OSVar GGG Olb8 Olb9 Olb10 Olb11 Olb12 TLB Out msg msg1 msg2)
(if *Chinese*
(setq msg "\n 初始化微软Word "
msg1 "\042初始化Word错误\042"
msg2 (strcat
"\042 警告"
"\n ===="
"\n 无法在您的计算机上检测到微软Word97/200X/XP软件\042"
)
)
(setq msg "\n Initializing Microsoft Word "
msg1 "\042Initialization Word Error\042"
msg2 (strcat
"\042 WARNING"
"\n ======="
"\n Can NOT detect Wordl97/200X/XP in your computer\042"
)
)
)
(if (null mswdc-wd100words)
(progn
(if (and (setq GGG
(vl-registry-read
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\WINWORD.EXE"
"Path"
)
)
(setq GGG (strcase (strcat GGG "WINWORD.EXE")))
)
(progn
(foreach OSVar (list "SYSTEMROOT" "WINDIR"
"WINBOOTDIR" "SYSTEMDRIVE"
"USERNAME" "COMPUTERNAME"
"HOMEDRIVE" "HOMEPATH"
"PROGRAMFILES"
)
(if (vl-string-search (strcat "%" OSVar "%") GGG)
(setq GGG (vl-string-subst
(strcase (getenv OSVar))
(strcat "%" OSVar "%")
GGG
)
)
)
)
(setq Olb8 (findfile (vl-string-subst "WORD8.OLB" "WINWORD.EXE" GGG)
)
Olb9 (findfile (vl-string-subst "WORD9.OLB" "WINWORD.EXE" GGG)
)
Olb10 (findfile
(vl-string-subst "WORD10.OLB" "WINWORD.EXE" GGG)
)
Olb11 (findfile
(vl-string-subst "MSWORD.OLB" "WINWORD.EXE" GGG)
)
Olb12 (findfile
(vl-string-subst "MSWORD.OLB" "WINWORD.EXE" GGG)
)
)
(cond ((= (vl-filename-base (vl-filename-directory GGG))
"OFFICE12"
) ;_ 结束=
(setq TLB Olb12
Out "2007"
) ;_ 结束setq
)
((= (vl-filename-base (vl-filename-directory GGG))
"OFFICE11"
) ;_ 结束=
(setq TLB Olb11
Out "2003"
) ;_ 结束setq
)
(Olb10
(setq TLB Olb10
Out "XP"
) ;_ 结束setq
)
(Olb9
(setq TLB Olb9
Out "2000"
) ;_ 结束setq
)
(Olb8
(setq TLB Olb8
Out "97"
) ;_ 结束setq
)
(t (setq Out "Version Unknown"))
) ;_ 结束cond
(if TLB
(progn
(princ (strcat MSG Out "..."))
(vlax-import-type-library
:tlb-filename TLB :methods-prefix
"mswdm-" :properties-prefix
"mswdp-" :constants-prefix "mswdc-"
)
)
)
)
(progn
;;(vldcl-msgbox "x" msg1 msg2)
;;(NBTF_GetOK (strcat "关于-"msg1 "[网蜂工具箱]")msg2 "")
(princ (strcat "关于-"msg1 "[网蜂工具箱]")msg2 ""))
(exit)
)
)
)
)
mswdc-wd100words
)
;|
Word Application Session Progress Function
函数名 (nbtf-vlDoc-app-new ShowExcelFlag)
功能打开一个新Word进程并新建一个文档.
参数 BOOLE T 显示, nil 隐藏
返回值 True VLOBJ Word进程的vla-object对象
Fail BOOLE NIL
示例:
(setq *wordapp* (nbtf-vlDoc-app-new T)) #<VLA-OBJECT _Application 001db27c>
|;
(Defun nbtf-vlDoc-app-New (UnHide / Rtn)
(if (nbtf-vlDoc-app-init)
(progn
(if *Chinese*
(princ "\n 新建微软Word工作表...")
(princ "\n Creating new Word Document file...")
)
(if (setq Rtn (vlax-get-or-create-object "word.Application"))
(progn
(vlax-invoke-method
(vlax-get-property Rtn 'Documents)
'add
)
(if UnHide
(vla-put-visible Rtn 1)
(vla-put-visible Rtn 0)
)
)
)
)
)
Rtn
)
;|
功能：打开Word文件
函数名 (nbtf-vlDoc-app-open DOCfilename ShowWordFlag)
功能新建(查找)Word进程并打开指定文档..
参数 STR DOC文档名称(全路径), 扩展名".DOC" 可选.
BOOLE T 显示, nil 隐藏
返回值 True VLOBJ Word进程vla-object对象
Fail BOOLE NIL
示例:
(setq *wordapp* (nbtf-vlDoc-app-open "C:/test.DOC" T)) #<VLA-OBJECT _Application 001efd2c>
|;
;;;打开Word文件
(Defun nbtf-vlDoc-app-open
(DOCFile UnHide / Rtn)
(setq DOCFile (strcase DOCFile))
(if (null (wcmatch DOCFile "*.DOC"))
(setq DOCFile (strcat DOCFile ".DOC"))
)
(if (and (findfile DOCFile)
(setq Rtn (vlax-get-or-create-object "Word.Application"))
)
(progn
(vlax-invoke-method
(vlax-get-property Rtn 'Documents)
'Open
DOCFile
)
(if UnHide
(vla-put-visible Rtn 1)
(vla-put-visible Rtn 0)
)
)
)
Rtn
)
;|
Word Application Session Progress Function
函数名 (nbtf-vlDoc-app-save WordSessionVLA-OBJECT)
功能保存当前文档.
参数 VLOBJ Word程序进存的vla-object对象
返回 True BOOLE T
Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-save *wordapp*) T
|;
(Defun nbtf-vlDoc-app-save (wordApp)
(equal (vlax-invoke-method
(vlax-get-property wordApp "ActiveDocument")
"Save"
)
:vlax-true
)
)
;|
Word Application Session Progress Function
函数名 (nbtf-vlDoc-app-saveas WordSessionVLA-OBJECT SavedFileName)
功能另存当前文档.
参数 VLOBJ Word进程vla-object对象
STR 保存DOC文件名(全路径)
NIL 缺省文件名"DOC.DOC"保存在当前图形目录.
返回值 True STRING 保存DOC文件名(全路径)
Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-saveas *wordapp* nil) "C:/Temp-Folder/DOC.DOC"
(nbtf-vlDoc-app-saveas *wordapp* "C:/Temp-Folder/DOC.DOC") "C:/Temp-Folder/DOC.DOC"
(nbtf-vlDoc-app-saveas *wordapp* nil) NIL
|;
(Defun nbtf-vlDoc-app-saveas (WDApp Filename / Rtn)
(if (null filename)
(setq filename (strcat (getvar "dwgprefix") "DOC.DOC"))
)
(if (null (wcmatch (setq filename (strcase Filename)) "*`.DOC"))
(setq filename (strcat filename ".DOC"))
)
(if (findfile Filename)
(vl-file-delete (findfile Filename))
)
(vlax-invoke-method
(vlax-get-property WDApp "ActiveDocument")
"SaveAs"
Filename
mswd-wdFormatDocument
:vlax-False
"" ;_密码.
:vlax-True
""
:vlax-False
:vlax-False
:vlax-False
:vlax-False
:vlax-False
)
(findfile Filename)
)
;|
Word Application Session Progress Function
函数名 (nbtf-vlDoc-app-quit WordSessionVLA-OBJECT SavedFlag)
功能退出Word并释放内存.
参数 VLOBJ Word进程vla-object对象
BOOLE 是否保存当前文档, T 保存, NIL 不保存
返回值 True BOOLE NIL
Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-quit *wordapp* nil) nil
|;
(Defun nbtf-vlDoc-app-quit (WDApp SaveYN)
(if SaveYN
(vlax-invoke-method
(vlax-get-property WDApp "ActiveDocument")
'Close
)
(vlax-invoke-method
(vlax-get-property WDApp "ActiveDocument")
'Close
:vlax-False
)
)
(vlax-invoke-method WDApp 'QUIT)
(vlax-release-object WDApp)
(setq WDApp nil)
(gc)
)
;|
Word Application Session Progress Function
函数名 (nbtf-vlDoc-app-kill)
功能关闭word.
参数 NONE 不保存
返回值 True BOOLE NIL
Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-kill T) nil
|;
(Defun nbtf-vlDoc-app-kill (SaveYN / ExlObj)
(while (setq WDApp (vlax-get-object "Word.Application"))
(nbtf-vlDoc-app-quit WDApp SaveYN)
)
)

;;;预加载WORD库
(Defun nbtf-vlDoc-app-Init
       (/ OSVar GGG Olb8 Olb9 Olb10 Olb11 Olb12 TLB Out msg msg1 msg2)
  (if *Chinese*
    (setq msg  "\n 初始化微软Word "
   msg1 "\042初始化Word错误\042"
   msg2 (strcat
   "\042 警告"
   "\n ===="
   "\n 无法在您的计算机上检测到微软Word97/200X/XP软件\042"
        )
    )
    (setq msg  "\n Initializing Microsoft Word "
   msg1 "\042Initialization Word Error\042"
   msg2 (strcat
   "\042 WARNING"
   "\n ======="
   "\n Can NOT detect Wordl97/200X/XP in your computer\042"
         )
    )
  )
  (if (null mswdc-wd100words)
    (progn
      (if (and (setq GGG
        (vl-registry-read
   "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\WINWORD.EXE"
   "Path"
        )
        )
        (setq GGG (strcase (strcat GGG "WINWORD.EXE")))
   )
 (progn
   (foreach OSVar (list "SYSTEMROOT"  "WINDIR"
          "WINBOOTDIR"  "SYSTEMDRIVE"
          "USERNAME"  "COMPUTERNAME"
          "HOMEDRIVE"  "HOMEPATH"
          "PROGRAMFILES"
         )
     (if (vl-string-search (strcat "%" OSVar "%") GGG)
       (setq GGG (vl-string-subst
     (strcase (getenv OSVar))
     (strcat "%" OSVar "%")
     GGG
   )
       )
     )
   )
   (setq Olb8  (findfile (vl-string-subst "WORD8.OLB" "WINWORD.EXE" GGG)
        )
  Olb9  (findfile (vl-string-subst "WORD9.OLB" "WINWORD.EXE" GGG)
        )
  Olb10 (findfile
   (vl-string-subst "WORD10.OLB" "WINWORD.EXE" GGG)
        )
  Olb11 (findfile
   (vl-string-subst "MSWORD.OLB" "WINWORD.EXE" GGG)
        )
  Olb12 (findfile
   (vl-string-subst "MSWORD.OLB" "WINWORD.EXE" GGG)
        )
   )
   (cond ((= (vl-filename-base (vl-filename-directory GGG))
      "OFFICE12"
   ) ;_ 结束=
   (setq TLB Olb12
         Out "2007"
   ) ;_ 结束setq
  )
  ((= (vl-filename-base (vl-filename-directory GGG))
      "OFFICE11"
   ) ;_ 结束=
   (setq TLB Olb11
         Out "2003"
   ) ;_ 结束setq
  )
  (Olb10 
   (setq TLB Olb10
         Out "XP"
   ) ;_ 结束setq
  )
  (Olb9
   (setq TLB Olb9
         Out "2000"
   ) ;_ 结束setq
  )
  (Olb8
   (setq TLB Olb8
         Out "97"
   ) ;_ 结束setq
  )
  (t (setq Out "Version Unknown"))
   ) ;_ 结束cond
   (if TLB
     (progn
       (princ (strcat MSG Out "..."))
       (vlax-import-type-library
  :tlb-filename   TLB      :methods-prefix
  "mswdm-"    :properties-prefix
  "mswdp-"    :constants-prefix "mswdc-"
        )
     )
   )
 )
 (progn
   ;;(vldcl-msgbox "x" msg1 msg2)
   ;;(NBTF_GetOK (strcat "关于-"msg1 "[网蜂<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>箱]")msg2 "")
   (princ (strcat "关于-"msg1 "[网蜂工具箱]")msg2 ""))
   (exit)
 )
      )
    )
  )
  mswdc-wd100words
)
;|
Word  Application Session Progress Function
函数名 (nbtf-vlDoc-app-new ShowExcelFlag)
功能 打开一个新Word进程并新建一个文档.
参数 BOOLE T 显示, nil 隐藏
返回值 True VLOBJ Word进程的vla-object对象
            Fail   BOOLE NIL
示例:
(setq *wordapp* (nbtf-vlDoc-app-new T))   #<VLA-OBJECT _Application 001db27c>
|;
(Defun nbtf-vlDoc-app-New (UnHide / Rtn)
  (if (nbtf-vlDoc-app-init)
    (progn
      (if *Chinese*
 (princ "\n 新建微软Word工作表...")
 (princ "\n Creating new Word Document file...")
      )
      (if (setq Rtn (vlax-get-or-create-object "word.Application"))
 (progn
   (vlax-invoke-method
     (vlax-get-property Rtn 'Documents)
     'add
   )
   (if UnHide
     (vla-put-visible Rtn 1)
     (vla-put-visible Rtn 0)
   )
 )
      )
    )
  )
  Rtn
)
;|
功能：打开Word文件
函数名 (nbtf-vlDoc-app-open DOCfilename ShowWordFlag)
功能 新建(查找)Word进程并打开指定文档..
参数 STR DOC文档名称(全路径), 扩展名".DOC" 可选.
 BOOLE T 显示, nil 隐藏
返回值 True VLOBJ Word进程vla-object对象
 Fail BOOLE NIL
示例:
(setq *wordapp* (nbtf-vlDoc-app-open "C:/test.DOC" T))   #<VLA-OBJECT _Application 001efd2c>
|;
;;;打开Word文件
(Defun nbtf-vlDoc-app-open
       (DOCFile UnHide / Rtn)
  (setq DOCFile (strcase DOCFile))
  (if (null (wcmatch DOCFile "*.DOC"))
    (setq DOCFile (strcat DOCFile ".DOC"))
  )
  (if (and (findfile DOCFile)
    (setq Rtn (vlax-get-or-create-object "Word.Application"))
      )
    (progn
      (vlax-invoke-method
 (vlax-get-property Rtn 'Documents)
 'Open
 DOCFile
      )
      (if UnHide
 (vla-put-visible Rtn 1)
 (vla-put-visible Rtn 0)
      )
    )
  )
  Rtn
)
;|
Word  Application Session Progress Function
函数名 (nbtf-vlDoc-app-save WordSessionVLA-OBJECT)
功能 保存当前文档.
参数 VLOBJ Word程序进存的vla-object对象
返回 True BOOLE T
 Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-save *wordapp*)   T
|;
(Defun nbtf-vlDoc-app-save (wordApp)
  (equal (vlax-invoke-method
    (vlax-get-property wordApp "ActiveDocument")
    "Save"
  )
  :vlax-true
  )
)
 ;|
Word  Application Session Progress Function
函数名 (nbtf-vlDoc-app-saveas WordSessionVLA-OBJECT SavedFileName)
功能 另存当前文档.
参数 VLOBJ Word进程vla-object对象
 STR 保存DOC文件名(全路径)
                NIL 缺省文件名"DOC.DOC"保存在当前图形目录.
返回值 True STRING 保存DOC文件名(全路径)
 Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-saveas *wordapp* nil)   "C:/Temp-Folder/DOC.DOC"
(nbtf-vlDoc-app-saveas *wordapp* "C:/Temp-Folder/DOC.DOC")   "C:/Temp-Folder/DOC.DOC"
(nbtf-vlDoc-app-saveas *wordapp* nil)   NIL
|;
(Defun nbtf-vlDoc-app-saveas (WDApp Filename / Rtn)
  (if (null filename)
    (setq filename (strcat (getvar "dwgprefix") "DOC.DOC"))
  )
  (if (null (wcmatch (setq filename (strcase Filename)) "*`.DOC"))
    (setq filename (strcat filename ".DOC"))
  )
  (if (findfile Filename)
    (vl-file-delete (findfile Filename))
  )
  (vlax-invoke-method
    (vlax-get-property WDApp "ActiveDocument")
    "SaveAs"
    Filename
    mswd-wdFormatDocument
    :vlax-False
    "" ;_密码.
    :vlax-True
    ""
    :vlax-False
    :vlax-False
    :vlax-False
    :vlax-False
    :vlax-False
  )
  (findfile Filename)
)
 ;|
Word  Application Session Progress Function
函数名 (nbtf-vlDoc-app-quit WordSessionVLA-OBJECT SavedFlag)
功能 退出Word并释放内存.
参数 VLOBJ Word进程vla-object对象
 BOOLE 是否保存当前文档, T 保存, NIL 不保存
返回值 True BOOLE NIL
 Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-quit *wordapp* nil)   nil
|;
(Defun nbtf-vlDoc-app-quit (WDApp SaveYN)
  (if SaveYN
    (vlax-invoke-method
      (vlax-get-property WDApp "ActiveDocument")
      'Close
    )
    (vlax-invoke-method
      (vlax-get-property WDApp "ActiveDocument")
      'Close
      :vlax-False
    )
  )
  (vlax-invoke-method WDApp 'QUIT)
  (vlax-release-object WDApp)
  (setq WDApp nil)
  (gc)
)
 ;|
Word  Application Session Progress Function
函数名 (nbtf-vlDoc-app-kill)
功能 关闭word.
参数 NONE 不保存
返回值 True BOOLE NIL
 Fail BOOLE NIL
示例:
(nbtf-vlDoc-app-kill T)   nil
|;
(Defun nbtf-vlDoc-app-kill (SaveYN / ExlObj)
  (while (setq WDApp (vlax-get-object "Word.Application"))
    (nbtf-vlDoc-app-quit WDApp SaveYN)
  )
)

[glow=255,red,2]大家来完善[/glow]

无痕 · 发表于 2007-12-11 21:38:00

就一个 vlax-import-type-library

NetBee · 发表于 2007-12-15 23:49:00

本帖最后由作者于 2007-12-15 23:53:44 编辑

继续:

;|
获取DOCS集ID
|;
(defun nbtf-vldoc-get-DOCS ()
(setq *WordApp-Docs*(VLA-GET-DOCUMENTS *WordApp*))
) ;_ 结束defun
;|
获取当前DOCID
|;
(Defun nbtf-vldoc-get-Doc()
(setq *WordApp-Doc*(vlax-get-property *WordApp* "ActiveDocument"))
)
;;; 获取文档的 paragraphs（进行格式设置）
(Defun nbtf-vldoc-get-paragraphs (doc)
(if(null doc)(setq doc(nbtf-vldoc-get-Doc)))
(MSWdP-GET-PARAGRAPHS doc)
) ;_ 结束Defun
(Defun nbtf-vlDoc-Add-text
(range text / stylename texth BOLD UNDERLINE obj)
;; 获取文档的 paragraphs（进行格式设置）
(cond ((and (= (type text) 'LIST)
(setq stylename (cdr (assoc 7 text)) ;_字体
texth (cdr (assoc 40 text)) ;_字高
BOLD (cdr (assoc 2 text)) ;_加粗.
UNDERLINE (cdr (assoc 3 text));_下线
text (cdr (assoc 1 text)) ;_文字
) ;_ 结束setq
(not text)
) ;_ 结束and
)
((vl-catch-all-error-p
(setq obj
(vl-catch-all-apply
'MSWdm-INSERTAFTER
(list
range
text
) ;_ 结束list
) ;_ 结束vl-catch-all-apply
) ;_ 结束setq
) ;_ 结束vl-catch-all-error-p
(princ (vl-catch-all-error-message obj))
nil
)
(T
(and BOLD (MSWdP-PUT-BOLD range 1)) ;_粗体.
(and texth (mswdp-put-size(mswdp-get-font range )texth)) ;_字高.
(and UNDERLINE(MSWdP-PUT-UNDERLINE range MSWdC-WDUNDERLINESINGLE)) ;下划线
)
) ;_ 结束cond
) ;_ 结束Defun

;|
获取DOCS集ID
|;
(defun nbtf-vldoc-get-DOCS ()
  (setq *WordApp-Docs*(VLA-GET-DOCUMENTS *WordApp*))
) ;_ 结束defun
;|
获取当前DOCID
|;
(Defun nbtf-vldoc-get-Doc()
  (setq *WordApp-Doc*(vlax-get-property *WordApp* "ActiveDocument"))
  )
;;; 获取文档的 paragraphs（进行格式设置）
(Defun nbtf-vldoc-get-paragraphs (doc)
  (if(null doc)(setq doc(nbtf-vldoc-get-Doc)))
  (MSWdP-GET-PARAGRAPHS doc)
) ;_ 结束Defun
(Defun nbtf-vlDoc-Add-text
       (range text / stylename texth BOLD UNDERLINE obj)
  ;; 获取文档的 paragraphs（进行格式设置）
  (cond ((and (= (type text) 'LIST)
       (setq stylename (cdr (assoc 7 text)) ;_字体
      texth     (cdr (assoc 40 text)) ;_字高
      BOLD      (cdr (assoc 2 text)) ;_加粗.
      UNDERLINE (cdr (assoc 3 text));_下线
      text      (cdr (assoc 1 text)) ;_文字
       ) ;_ 结束setq
       (not text)
  ) ;_ 结束and
 )
 ((vl-catch-all-error-p
    (setq obj
    (vl-catch-all-apply
      'MSWdm-INSERTAFTER
      (list
        range
        text
      ) ;_ 结束list
    ) ;_ 结束vl-catch-all-apply
    ) ;_ 结束setq
  ) ;_ 结束vl-catch-all-error-p
   (princ (vl-catch-all-error-message obj))
  nil
 )
 (T
  (and BOLD (MSWdP-PUT-BOLD range 1)) ;_粗体.
  (and texth (mswdp-put-size(mswdp-get-font range )texth)) ;_字高.
  (and UNDERLINE(MSWdP-PUT-UNDERLINE range MSWdC-WDUNDERLINESINGLE)) ;下划线
 )
  ) ;_ 结束cond
) ;_ 结束Defun

示例：

(defun C:test (/ paragraphs pg font range)
(setq *wordapp* (nbtf-vlDoc-app-new T))
(setq paragraphs (nbtf-vldoc-get-paragraphs nil))
(SETQ pg (MSWdP-GET-LAST paragraphs))
(SETQ range (MSWdP-GET-RANGE pg))
(nbtf-vlDoc-Add-text range (list(cons 1 "写了一个文本\n") '(40 . 24)))
) ;_ 结束defun

tchen · 发表于 2007-12-16 09:56:00

呵呵太复杂了就像LISP操作EXCEL一样很复杂还是用VC好了

killer9806 · 发表于 2007-12-18 22:33:00

个人认为如果要和别的程序进行嵌接最好用VC，方便。

用LISP进行操作，证明楼主能力相当的强。

谢楼主分享。

jxphklibin · 发表于 2009-1-5 10:37:00

Netbee楼主，你的代码很好，支持了，继续努力！

happyboy75 · 发表于 2009-1-5 10:58:00

高顶一下

yshf · 发表于 2011-11-18 18:35:17

好，

pslstar · 发表于 2011-11-29 22:36:31

好厉害啊太厉害了

账号		自动登录	找回密码
密码			注册