明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 48532|回复: 205

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

    [复制链接]
发表于 2010-12-13 14:05 | 显示全部楼层 |阅读模式
本帖最后由 Gu_xl 于 2013-6-11 10:44 编辑

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

点评

G版搞个LISP操纵EXECL的!!!好吗!!?  发表于 2015-7-22 08:42
谢谢分享  发表于 2012-3-17 13:32

评分

参与人数 2明经币 +3 金钱 +12 收起 理由
革天明 + 1
caoyin + 2 + 12 谢谢分享!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2010-12-24 20:07 | 显示全部楼层
本帖最后由 jiaodahaoren 于 2010-12-24 20:09 编辑

回复 Gu_xl 的帖子

这是什么呢?函数的入口在哪儿?
回复 支持 0 反对 1

使用道具 举报

发表于 2020-5-24 20:52 | 显示全部楼层
来向 G 版学习,真的很佩服版主,版主的天赋和灵性令人神往,难以企及,只能心向往之~
回复 支持 0 反对 1

使用道具 举报

发表于 2023-5-12 16:37 | 显示全部楼层
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)
 楼主| 发表于 2010-12-13 14:05 | 显示全部楼层

  1. ;;;(gxl-word-app-saveas (vla-get-ActiveDocument wordapp) Filename) 另存为 (gxl-word-app-saveas (vla-get-ActiveDocument wordapp) "c:\\a1.doc")
  2. (Defun gxl-word-app-saveas (DocObj Filename / Rtn)

  3.   (if (null filename)

  4.     (setq filename (strcat (getvar "dwgprefix") "DOC.DOC"))

  5.   ) ;_ if

  6.   (if (null (wcmatch (setq filename (strcase Filename)) "*`.DOC"))

  7.     (setq filename (strcat filename ".DOC"))

  8.   ) ;_ if

  9.   (if (findfile Filename)

  10.     (vl-file-delete (findfile Filename))

  11.   ) ;_ if
  12. ;|
  13.   (vlax-invoke-method

  14.     (vlax-get-property wordapp "ActiveDocument")

  15.     "SaveAs"
  16.     Filename
  17.   ) ;_ vlax-invoke-method
  18. |;
  19.   
  20.   (vla-saveas DocObj Filename)
  21.   (findfile Filename)

  22. ) ;_ Defun
  23. ;;;(gxl-word-app-quit wordapp SaveYN) 退出Word
  24. ;;;(gxl-word-app-quit wordapp1 nil)
  25. (Defun gxl-word-app-quit (wordapp SaveYN / error)

  26.   (if SaveYN
  27. ;|
  28.     (vlax-invoke-method
  29.       (vlax-get-property wordapp "ActiveDocument")
  30.       'Close
  31.       :vlax-true
  32.     )|;
  33.     (mswm-Close (vla-get-ActiveDocument wordapp) :vlax-true)
  34.     ;|
  35.     (vlax-invoke-method
  36.       (vlax-get-property wordapp "ActiveDocument")
  37.       'Close
  38.       :vlax-False
  39.     )
  40.     |;
  41.     (mswm-Close (vla-get-ActiveDocument wordapp) :vlax-False)
  42.   )
  43.   
  44.   (vlax-release-object wordapp)

  45.   (setq wordapp nil)

  46. (gc)
  47. )
  48. ;;;退出word
  49. ;;;(gxl-word-app-kill nil)
  50. (Defun gxl-word-app-kill (SaveYN / wordObj error)
  51.   (setq wordObj (vlax-get-object "Word.Application"))
  52.   (if wordObj
  53.     (while (not (VL-CATCH-ALL-ERROR-P (setq error (VL-CATCH-ALL-APPLY 'vlax-get-property (list wordObj "ActiveDocument")))))
  54.       (if SaveYN
  55.       (vlax-invoke-method error 'close :vlax-true)
  56.         (vlax-invoke-method error 'close :vlax-False)
  57.         )
  58.        
  59.       )
  60.     )
  61.       (vlax-invoke-method wordObj 'QUIT)

  62.   (vlax-release-object wordObj)

  63.   (setq wordObj nil)

  64.   
  65.   (gc)
  66. )
  67. ;;;增加Word
  68. ;;;(gxl-word-book-add wordapp)
  69. (defun gxl-word-Document-add (wordapp)
  70.   ;|
  71.   (vlax-invoke-method
  72.     (vlax-get-property wordapp 'Documents)
  73.     'Add

  74.   ) ;_ vlax-invoke-method
  75.   |;
  76.   (mswm-add (vla-get-Documents wordapp))
  77. )
  78. ;;;(gxl-word-get-activeDocument wordapp) 获取活动文档
  79. (defun gxl-word-get-activeDocument (wordapp)
  80.   ;(vlax-get-property wordapp "ActiveDocument")
  81.   (vla-get-ActiveDocument wordapp)
  82.   )
  83. ;;;Range方法
  84. (defun gxl-word-Range (DocObj startpos endPos)
  85.   (mswm-range DocObj startpos endPos)
  86.   )
  87. ;;;获取文档最后的段落
  88. ;;;(setq pg (gxl-word-get-lastparagraph (gxl-word-get-activeDocument (vlax-get-object "Word.Application"))))
  89. (defun gxl-word-get-lastparagraph (docobj)
  90.   (mswp-get-last (mswp-get-paragraphs docobj))
  91.   )
  92. ;;;获取段落范围
  93. ;;;(setq rg (gxl-word-get-range pg))
  94. (defun gxl-word-get-range (obj)
  95.   (mswp-get-Range obj)
  96.   )
  97. ;;;段尾插入文本
  98. ;;;(gxl-word-insertafter rg "gxl-word-insertafter")
  99. (defun gxl-word-insertafter (range text)
  100.   (mswm-InsertAfter range text)
  101.   )
  102. ;;;段尾插入文本
  103. ;;;(gxl-word-insertBefore rg "gxl-word-insertBefore")
  104. (defun gxl-word-insertBefore (range text)
  105.   (mswm-InsertBefore range text)
  106.   )
  107. ;;;设置粗体 :vlax-true or :vlax-false
  108. ;;;(gxl-word-bold rg :vlax-true)
  109. (defun gxl-word-bold (range boolen)
  110.   (mswp-put-bold range boolen)
  111.   )
  112. ;;;设置下划线
  113. ;;;(gxl-word-underline rg mswc-wdUnderlineSingle)
  114. (defun gxl-word-underline (range lt)
  115.   (mswp-put-Underline range lt)
  116.   )
  117. ;;;设置字体
  118. ;;;(mswp-put-name (mswp-get-font (mswm-range (gxl-word-get-activeDocument wordapp) 0 20)) "宋体")
  119. ;;; (vlax-for obj (MSWP-GET-PARAGRAPHS (gxl-word-get-activeDocument wordapp)) (mswp-put-name(mswp-get-font (MSWP-GET-RANGE obj))"宋体") )
  120. (defun gxl-word-put-FontName (range name)
  121.   (mswp-put-name (mswp-get-font range) name)
  122.   )

  123. ;;;设置字体大小
  124. ;;;(mswp-put-Size (mswp-get-font (mswm-range (gxl-word-get-activeDocument wordapp) 0 20)) 24)
  125. ;;;(vlax-for obj (MSWP-GET-PARAGRAPHS (gxl-word-get-activeDocument wordapp)) (mswp-put-size(mswp-get-font (MSWP-GET-RANGE obj))20))
  126. (defun gxl-word-put-FontSize (range Size)
  127.   (mswp-put-Size (mswp-get-font range) Size)
  128.   )



点评

谢谢分享  发表于 2012-3-17 13:33
发表于 2010-12-13 16:02 | 显示全部楼层
支持!学习!谢谢分享!
 楼主| 发表于 2010-12-24 20:57 | 显示全部楼层
回复 jiaodahaoren 的帖子

呵呵,你还需努力,这些可能对你来说太难了!
发表于 2010-12-25 02:54 | 显示全部楼层
熟悉word对象模型的再改改excel相关的l代码应该能把这个搞出来,但需要一些时间,不管怎么样支持一下吧
 楼主| 发表于 2010-12-25 10:33 | 显示全部楼层
本帖最后由 Gu_xl 于 2010-12-25 10:38 编辑

  1. ;;;Lisp 操控Word示例
  2. ;;;编制:Gu_xl 2010年12月
  3. (defun c:myword (/ *WordApp* document  paragraph Range)
  4. ;;;初始化Word
  5.   (gxl-word-app-Init)
  6. ;;;新建Word 的应用程序
  7.   (setq *WordApp* (gxl-word-app-New nil))
  8.   ;;;新建文档
  9.   (setq document (gxl-word-Document-add *WordApp*))
  10.   ;;;保存文档
  11.   ;(gxl-word-app-saveas document "d:\\MyTest.Doc")
  12.   (MSWM-add (mswp-get-paragraphs document))
  13.   ;;;获取文档最后的段落
  14.    (setq paragraph (mswp-get-last (mswp-get-paragraphs document)))
  15.   ;;;设置段落居中
  16.     (vla-put-alignment paragraph mswc-wdAlignParagraphCenter)
  17.   ;;;获取段落的Range
  18.     (setq Range (MSWP-GET-RANGE paragraph))
  19.   ;;;设置Range字体为黑体
  20.     (mswp-put-name (mswp-get-font range) "黑体")
  21.   ;;; 设置Range字体大小
  22.     (mswp-put-size (mswp-get-font range) 16)
  23.   ;;;设置Range字体加粗
  24.     (mswp-put-bold range :vlax-true)
  25.     ;;;添加文字内容
  26.     (MSWM-INSERTAFTER Range "Lisp 操控Word示例")
  27.   ;;;文档添加新的段落
  28.     (MSWM-add (mswp-get-paragraphs document))
  29.   ;;;获取文档最后的段落
  30.     (setq paragraph (mswp-get-last (mswp-get-paragraphs document)))
  31.   ;;;设置段落居左对齐
  32.     (vla-put-alignment paragraph mswc-wdAlignParagraphLeft)
  33.   ;;;获取段落的Range
  34.     (setq Range (MSWP-GET-RANGE paragraph))
  35.     (mswp-put-name (mswp-get-font range) "宋体")
  36.     (mswp-put-size (mswp-get-font range) 14)
  37.     (mswp-put-bold range :vlax-false)
  38.     (MSWM-INSERTAFTER Range "Lisp 操控Word示例的第一段落")
  39.     ;;;文档添加新的段落
  40.     (MSWM-add (mswp-get-paragraphs document))
  41.   ;;;获取文档最后的段落
  42.     (setq paragraph (mswp-get-last (mswp-get-paragraphs document)))
  43.   ;;;设置段落居左对齐
  44.     (vla-put-alignment paragraph mswc-wdAlignParagraphLeft)
  45.   ;;;获取段落的Range
  46.     (setq Range (MSWP-GET-RANGE paragraph))
  47.     (MSWM-INSERTAFTER Range "2010年12月 编制 By :Gu_xl")

  48.    ;;;保存文档
  49.    (GXL-WORD-APP-SAVEAS document "d:\\MyTest.Doc")
  50.   ;;;保存所有文档退出
  51.   (gxl-word-app-kill t)
  52.   )

评分

参与人数 1威望 +1 明经币 +1 金钱 +30 收起 理由
highflybir + 1 + 1 + 30 好帖子!

查看全部评分

发表于 2010-12-25 11:04 | 显示全部楼层
谢谢楼主共享代码!
发表于 2010-12-25 17:33 | 显示全部楼层
MARK!!!!!!!!!!!!!!!!!!!!
发表于 2010-12-27 21:35 | 显示全部楼层
太难度了!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 18:10 , Processed in 0.231803 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表