【Gu_xl】Lisp操控Word编程技术

Gu_xl · 发表于 2010-12-13 14:05:13

本帖最后由 Gu_xl 于 2013-6-11 10:44 编辑

游客，本帖隐藏的内容需要发帖数高于 10 才可浏览，你当前发帖数只有 0

jiaodahaoren · 发表于 2010-12-24 20:07:39

本帖最后由 jiaodahaoren 于 2010-12-24 20:09 编辑

回复 Gu_xl 的帖子

这是什么呢？函数的入口在哪儿？

飞鱼StrawHaat · 发表于 2020-5-24 20:52:18

来向 G 版学习，真的很佩服版主，版主的天赋和灵性令人神往，难以企及，只能心向往之~

ht1480 · 发表于 2023-5-12 16:37:54

snddd2000 发表于 2018-3-9 16:05
gu版，请教个问题，lisp操作word替换文字的函数的参数怎么写？
(vlax-invoke-method
Find ...

(setq word (vlax-create-object "Word.Application"))
(vlax-put-property word 'Visible 1)
(setq docs (vlax-get-property word 'Documents))
(setq doc (vlax-invoke-method docs 'Open "C:/Users/Administrator/Desktop/测试.doc"))
(setq range (vlax-get-property doc 'Content))
(setq find (vlax-get-property range 'Find))
(vlax-invoke-method find 'ClearFormatting)
(setq thq "b792")
(setq thh "BBBB")
;(vlax-invoke-method find 'Execute "BBBB" :vlax-true :vlax-true :vlax-false :vlax-false :vlax-false :vlax-true :vlax-false :vlax-false "b792" 2 :vlax-false :vlax-false :vlax-false)
;(vlax-invoke-method find 'Execute "b792" :vlax-true :vlax-true :vlax-false :vlax-false :vlax-false :vlax-true :vlax-false :vlax-false "BBBB" 2 :vlax-false :vlax-false :vlax-false)
(vlax-invoke-method find 'Execute thq :vlax-true :vlax-true :vlax-false :vlax-false :vlax-false :vlax-true :vlax-false :vlax-false thh 2 :vlax-false :vlax-false :vlax-false)
;(vlax-invoke-method find 'Execute (cons 'Replace 'wdReplaceAll) (cons 'Forward 1))
(vlax-invoke-method doc 'SaveAs "D:/New.docx" )
(vlax-invoke-method doc 'Close)
(vlax-invoke-method word 'Quit)

Gu_xl · 发表于 2010-12-13 14:05:55

;;;(gxl-word-app-saveas (vla-get-ActiveDocument wordapp) Filename) 另存为 (gxl-word-app-saveas (vla-get-ActiveDocument wordapp) "c:\\a1.doc")
(Defun gxl-word-app-saveas (DocObj Filename / Rtn)
(if (null filename)
(setq filename (strcat (getvar "dwgprefix") "DOC.DOC"))
) ;_ if
(if (null (wcmatch (setq filename (strcase Filename)) "*`.DOC"))
(setq filename (strcat filename ".DOC"))
) ;_ if
(if (findfile Filename)
(vl-file-delete (findfile Filename))
) ;_ if
;|
(vlax-invoke-method
(vlax-get-property wordapp "ActiveDocument")
"SaveAs"
Filename
) ;_ vlax-invoke-method
|;
(vla-saveas DocObj Filename)
(findfile Filename)
) ;_ Defun
;;;(gxl-word-app-quit wordapp SaveYN) 退出Word
;;;(gxl-word-app-quit wordapp1 nil)
(Defun gxl-word-app-quit (wordapp SaveYN / error)
(if SaveYN
;|
(vlax-invoke-method
(vlax-get-property wordapp "ActiveDocument")
'Close
:vlax-true
)|;
(mswm-Close (vla-get-ActiveDocument wordapp) :vlax-true)
;|
(vlax-invoke-method
(vlax-get-property wordapp "ActiveDocument")
'Close
:vlax-False
)
|;
(mswm-Close (vla-get-ActiveDocument wordapp) :vlax-False)
)
(vlax-release-object wordapp)
(setq wordapp nil)
(gc)
)
;;;退出word
;;;(gxl-word-app-kill nil)
(Defun gxl-word-app-kill (SaveYN / wordObj error)
(setq wordObj (vlax-get-object "Word.Application"))
(if wordObj
(while (not (VL-CATCH-ALL-ERROR-P (setq error (VL-CATCH-ALL-APPLY 'vlax-get-property (list wordObj "ActiveDocument")))))
(if SaveYN
(vlax-invoke-method error 'close :vlax-true)
(vlax-invoke-method error 'close :vlax-False)
)
)
)
(vlax-invoke-method wordObj 'QUIT)
(vlax-release-object wordObj)
(setq wordObj nil)
(gc)
)
;;;增加Word
;;;(gxl-word-book-add wordapp)
(defun gxl-word-Document-add (wordapp)
;|
(vlax-invoke-method
(vlax-get-property wordapp 'Documents)
'Add
) ;_ vlax-invoke-method
|;
(mswm-add (vla-get-Documents wordapp))
)
;;;(gxl-word-get-activeDocument wordapp) 获取活动文档
(defun gxl-word-get-activeDocument (wordapp)
;(vlax-get-property wordapp "ActiveDocument")
(vla-get-ActiveDocument wordapp)
)
;;;Range方法
(defun gxl-word-Range (DocObj startpos endPos)
(mswm-range DocObj startpos endPos)
)
;;;获取文档最后的段落
;;;(setq pg (gxl-word-get-lastparagraph (gxl-word-get-activeDocument (vlax-get-object "Word.Application"))))
(defun gxl-word-get-lastparagraph (docobj)
(mswp-get-last (mswp-get-paragraphs docobj))
)
;;;获取段落范围
;;;(setq rg (gxl-word-get-range pg))
(defun gxl-word-get-range (obj)
(mswp-get-Range obj)
)
;;;段尾插入文本
;;;(gxl-word-insertafter rg "gxl-word-insertafter")
(defun gxl-word-insertafter (range text)
(mswm-InsertAfter range text)
)
;;;段尾插入文本
;;;(gxl-word-insertBefore rg "gxl-word-insertBefore")
(defun gxl-word-insertBefore (range text)
(mswm-InsertBefore range text)
)
;;;设置粗体 :vlax-true or :vlax-false
;;;(gxl-word-bold rg :vlax-true)
(defun gxl-word-bold (range boolen)
(mswp-put-bold range boolen)
)
;;;设置下划线
;;;(gxl-word-underline rg mswc-wdUnderlineSingle)
(defun gxl-word-underline (range lt)
(mswp-put-Underline range lt)
)
;;;设置字体
;;;(mswp-put-name (mswp-get-font (mswm-range (gxl-word-get-activeDocument wordapp) 0 20)) "宋体")
;;; (vlax-for obj (MSWP-GET-PARAGRAPHS (gxl-word-get-activeDocument wordapp)) (mswp-put-name(mswp-get-font (MSWP-GET-RANGE obj))"宋体") )
(defun gxl-word-put-FontName (range name)
(mswp-put-name (mswp-get-font range) name)
)
;;;设置字体大小
;;;(mswp-put-Size (mswp-get-font (mswm-range (gxl-word-get-activeDocument wordapp) 0 20)) 24)
;;;(vlax-for obj (MSWP-GET-PARAGRAPHS (gxl-word-get-activeDocument wordapp)) (mswp-put-size(mswp-get-font (MSWP-GET-RANGE obj))20))
(defun gxl-word-put-FontSize (range Size)
(mswp-put-Size (mswp-get-font range) Size)
)

;;;(gxl-word-app-saveas (vla-get-ActiveDocument wordapp) Filename) 另存为 (gxl-word-app-saveas (vla-get-ActiveDocument wordapp) "c:\\a1.doc") 
(Defun gxl-word-app-saveas (DocObj Filename / Rtn) 
 
  (if (null filename) 
 
    (setq filename (strcat (getvar "dwgprefix") "DOC.DOC")) 
 
  ) ;_ if 
 
  (if (null (wcmatch (setq filename (strcase Filename)) "*`.DOC")) 
 
    (setq filename (strcat filename ".DOC")) 
 
  ) ;_ if 
 
  (if (findfile Filename) 
 
    (vl-file-delete (findfile Filename)) 
 
  ) ;_ if 
;| 
  (vlax-invoke-method 
 
    (vlax-get-property wordapp "ActiveDocument") 
 
    "SaveAs" 
    Filename 
  ) ;_ vlax-invoke-method 
|; 
   
  (vla-saveas DocObj Filename) 
  (findfile Filename) 
 
) ;_ Defun 
;;;(gxl-word-app-quit wordapp SaveYN) 退出Word 
;;;(gxl-word-app-quit wordapp1 nil) 
(Defun gxl-word-app-quit (wordapp SaveYN / error) 
 
  (if SaveYN 
;| 
    (vlax-invoke-method 
      (vlax-get-property wordapp "ActiveDocument") 
      'Close 
      :vlax-true 
    )|; 
    (mswm-Close (vla-get-ActiveDocument wordapp) :vlax-true) 
    ;| 
    (vlax-invoke-method 
      (vlax-get-property wordapp "ActiveDocument") 
      'Close 
      :vlax-False 
    ) 
    |; 
    (mswm-Close (vla-get-ActiveDocument wordapp) :vlax-False) 
  ) 
   
  (vlax-release-object wordapp) 
 
  (setq wordapp nil) 
 
(gc) 
) 
;;;退出word 
;;;(gxl-word-app-kill nil) 
(Defun gxl-word-app-kill (SaveYN / wordObj error) 
  (setq wordObj (vlax-get-object "Word.Application")) 
  (if wordObj 
    (while (not (VL-CATCH-ALL-ERROR-P (setq error (VL-CATCH-ALL-APPLY 'vlax-get-property (list wordObj "ActiveDocument"))))) 
      (if SaveYN 
      (vlax-invoke-method error 'close :vlax-true) 
        (vlax-invoke-method error 'close :vlax-False) 
        ) 
        
      ) 
    ) 
      (vlax-invoke-method wordObj 'QUIT) 
 
  (vlax-release-object wordObj) 
 
  (setq wordObj nil) 
 
   
  (gc) 
) 
;;;增加Word 
;;;(gxl-word-book-add wordapp) 
(defun gxl-word-Document-add (wordapp) 
  ;| 
  (vlax-invoke-method 
    (vlax-get-property wordapp 'Documents) 
    'Add 
 
  ) ;_ vlax-invoke-method 
  |; 
  (mswm-add (vla-get-Documents wordapp)) 
) 
;;;(gxl-word-get-activeDocument wordapp) 获取活动文档 
(defun gxl-word-get-activeDocument (wordapp) 
  ;(vlax-get-property wordapp "ActiveDocument") 
  (vla-get-ActiveDocument wordapp) 
  ) 
;;;Range方法 
(defun gxl-word-Range (DocObj startpos endPos) 
  (mswm-range DocObj startpos endPos) 
  ) 
;;;获取文档最后的段落 
;;;(setq pg (gxl-word-get-lastparagraph (gxl-word-get-activeDocument (vlax-get-object "Word.Application")))) 
(defun gxl-word-get-lastparagraph (docobj) 
  (mswp-get-last (mswp-get-paragraphs docobj)) 
  ) 
;;;获取段落范围 
;;;(setq rg (gxl-word-get-range pg)) 
(defun gxl-word-get-range (obj) 
  (mswp-get-Range obj) 
  ) 
;;;段尾插入文本 
;;;(gxl-word-insertafter rg "gxl-word-insertafter") 
(defun gxl-word-insertafter (range text) 
  (mswm-InsertAfter range text) 
  ) 
;;;段尾插入文本 
;;;(gxl-word-insertBefore rg "gxl-word-insertBefore") 
(defun gxl-word-insertBefore (range text) 
  (mswm-InsertBefore range text) 
  ) 
;;;设置粗体 :vlax-true or :vlax-false 
;;;(gxl-word-bold rg :vlax-true) 
(defun gxl-word-bold (range boolen) 
  (mswp-put-bold range boolen) 
  ) 
;;;设置下划线 
;;;(gxl-word-underline rg mswc-wdUnderlineSingle) 
(defun gxl-word-underline (range lt) 
  (mswp-put-Underline range lt) 
  ) 
;;;设置字体 
;;;(mswp-put-name (mswp-get-font (mswm-range (gxl-word-get-activeDocument wordapp) 0 20)) "宋体") 
;;; (vlax-for obj (MSWP-GET-PARAGRAPHS (gxl-word-get-activeDocument wordapp)) (mswp-put-name(mswp-get-font (MSWP-GET-RANGE obj))"宋体") ) 
(defun gxl-word-put-FontName (range name) 
  (mswp-put-name (mswp-get-font range) name) 
  ) 
 
;;;设置字体大小 
;;;(mswp-put-Size (mswp-get-font (mswm-range (gxl-word-get-activeDocument wordapp) 0 20)) 24) 
;;;(vlax-for obj (MSWP-GET-PARAGRAPHS (gxl-word-get-activeDocument wordapp)) (mswp-put-size(mswp-get-font (MSWP-GET-RANGE obj))20)) 
(defun gxl-word-put-FontSize (range Size) 
  (mswp-put-Size (mswp-get-font range) Size) 
  )

xhq1954425 · 发表于 2010-12-13 16:02:45

支持！学习！

谢谢分享！

Gu_xl · 发表于 2010-12-24 20:57:54

回复 jiaodahaoren 的帖子

呵呵，你还需努力，这些可能对你来说太难了！

cnks · 发表于 2010-12-25 02:54:32

熟悉word对象模型的再改改excel相关的l代码应该能把这个搞出来，但需要一些时间，不管怎么样支持一下吧

Gu_xl · 发表于 2010-12-25 10:33:36

本帖最后由 Gu_xl 于 2010-12-25 10:38 编辑

;;;Lisp 操控Word示例
;;;编制：Gu_xl 2010年12月
(defun c:myword (/ *WordApp* document paragraph Range)
;;;初始化Word
(gxl-word-app-Init)
;;;新建Word 的应用程序
(setq *WordApp* (gxl-word-app-New nil))
;;;新建文档
(setq document (gxl-word-Document-add *WordApp*))
;;;保存文档
;(gxl-word-app-saveas document "d:\\MyTest.Doc")
(MSWM-add (mswp-get-paragraphs document))
;;;获取文档最后的段落
(setq paragraph (mswp-get-last (mswp-get-paragraphs document)))
;;;设置段落居中
(vla-put-alignment paragraph mswc-wdAlignParagraphCenter)
;;;获取段落的Range
(setq Range (MSWP-GET-RANGE paragraph))
;;;设置Range字体为黑体
(mswp-put-name (mswp-get-font range) "黑体")
;;; 设置Range字体大小
(mswp-put-size (mswp-get-font range) 16)
;;;设置Range字体加粗
(mswp-put-bold range :vlax-true)
;;;添加文字内容
(MSWM-INSERTAFTER Range "Lisp 操控Word示例")
;;;文档添加新的段落
(MSWM-add (mswp-get-paragraphs document))
;;;获取文档最后的段落
(setq paragraph (mswp-get-last (mswp-get-paragraphs document)))
;;;设置段落居左对齐
(vla-put-alignment paragraph mswc-wdAlignParagraphLeft)
;;;获取段落的Range
(setq Range (MSWP-GET-RANGE paragraph))
(mswp-put-name (mswp-get-font range) "宋体")
(mswp-put-size (mswp-get-font range) 14)
(mswp-put-bold range :vlax-false)
(MSWM-INSERTAFTER Range "Lisp 操控Word示例的第一段落")
;;;文档添加新的段落
(MSWM-add (mswp-get-paragraphs document))
;;;获取文档最后的段落
(setq paragraph (mswp-get-last (mswp-get-paragraphs document)))
;;;设置段落居左对齐
(vla-put-alignment paragraph mswc-wdAlignParagraphLeft)
;;;获取段落的Range
(setq Range (MSWP-GET-RANGE paragraph))
(MSWM-INSERTAFTER Range "2010年12月编制 By :Gu_xl")
;;;保存文档
(GXL-WORD-APP-SAVEAS document "d:\\MyTest.Doc")
;;;保存所有文档退出
(gxl-word-app-kill t)
)

;;;Lisp 操控Word示例 
;;;编制：Gu_xl 2010年12月 
(defun c:myword (/ *WordApp* document  paragraph Range) 
;;;初始化Word 
  (gxl-word-app-Init) 
;;;新建Word 的应用程序 
  (setq *WordApp* (gxl-word-app-New nil)) 
  ;;;新建文档 
  (setq document (gxl-word-Document-add *WordApp*)) 
  ;;;保存文档 
  ;(gxl-word-app-saveas document "d:\\MyTest.Doc") 
  (MSWM-add (mswp-get-paragraphs document)) 
  ;;;获取文档最后的段落 
   (setq paragraph (mswp-get-last (mswp-get-paragraphs document))) 
  ;;;设置段落居中 
    (vla-put-alignment paragraph mswc-wdAlignParagraphCenter) 
  ;;;获取段落的Range 
    (setq Range (MSWP-GET-RANGE paragraph)) 
  ;;;设置Range字体为黑体 
    (mswp-put-name (mswp-get-font range) "黑体") 
  ;;; 设置Range字体大小 
    (mswp-put-size (mswp-get-font range) 16) 
  ;;;设置Range字体加粗 
    (mswp-put-bold range :vlax-true) 
    ;;;添加文字内容 
    (MSWM-INSERTAFTER Range "Lisp 操控Word示例") 
  ;;;文档添加新的段落 
    (MSWM-add (mswp-get-paragraphs document)) 
  ;;;获取文档最后的段落 
    (setq paragraph (mswp-get-last (mswp-get-paragraphs document))) 
  ;;;设置段落居左对齐 
    (vla-put-alignment paragraph mswc-wdAlignParagraphLeft) 
  ;;;获取段落的Range 
    (setq Range (MSWP-GET-RANGE paragraph)) 
    (mswp-put-name (mswp-get-font range) "宋体") 
    (mswp-put-size (mswp-get-font range) 14) 
    (mswp-put-bold range :vlax-false) 
    (MSWM-INSERTAFTER Range "Lisp 操控Word示例的第一段落") 
    ;;;文档添加新的段落 
    (MSWM-add (mswp-get-paragraphs document)) 
  ;;;获取文档最后的段落 
    (setq paragraph (mswp-get-last (mswp-get-paragraphs document))) 
  ;;;设置段落居左对齐 
    (vla-put-alignment paragraph mswc-wdAlignParagraphLeft) 
  ;;;获取段落的Range 
    (setq Range (MSWP-GET-RANGE paragraph)) 
    (MSWM-INSERTAFTER Range "2010年12月 编制 By :Gu_xl") 
 
   ;;;保存文档 
   (GXL-WORD-APP-SAVEAS document "d:\\MyTest.Doc") 
  ;;;保存所有文档退出 
  (gxl-word-app-kill t) 
  )

highflybir · 发表于 2010-12-25 11:04:06

谢谢楼主共享代码！

icefrog · 发表于 2010-12-25 17:33:20

MARK!!!!!!!!!!!!!!!!!!!!

yangw761 · 发表于 2010-12-27 21:35:07

太难度了！！！

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

[【Gu_xl】] 【Gu_xl】Lisp操控Word编程技术

点评

评分

本帖被以下淘专辑推荐:

点评

评分