将表数据输出到Excel (新建工作表)

admin

1. <div>;;函数： (List采用Save采用Excel List)
2. ;;功能： 将表数据输出到Excel (新建工作表)
3. ;;参数： List 表，可以是一维或者二维表，或任意 list 表数据
4. ;;返回： 0
5. ;;示例： (List采用Save采用Excel '(1 2 3))
6. (defun List采用Save采用Excel( Lit / GetPy PutPy wbs wb sht xcells d c r)
7. (setq *appxls* (vlax-get-or-create-object "excel.application"))
8. (setq GetPy vlax-get-property PutPy vlax-put-property)
9. (setq wbs (GetPy *appxls* 'Workbooks))
10. ;;判断工作薄（集合）是否为空，若空则新建工作簿，并返回工作薄指针
11. (setq wb (if (= 0 (GetPy wbs 'count))
12.     (vlax-invoke-method wbs 'add)
13.     (GetPy wbs 'item 1)) ;;如果不为空则返回第一个工作薄
14. )
15. ;;新建工作表，用于导出数据。 (GetPy wb 'sheets) 是工作表集合对象
16. (setq sht (vlax-invoke-method (GetPy wb 'sheets) 'add))
17. ;;得到工作表的 cells 对象，该对象与 range 对象的区别就是可以用行列定位
18. (setq xcells (GetPy sht 'cells) r 0 c 0)
19. (if (= (type Lit) 'LIST)
20. (repeat (length Lit)
21.     (setq d (nth r Lit) r (1+ r))
22.     (if (= (type d) 'LIST)
23.         (repeat (length d) (PutPy xcells 'item r (1+ c)(vl-princ-to-string(nth c d))) (setq c (1+ c)) )
24.     (PutPy xcells 'item 1 r (vl-princ-to-string d))
25.     )
26.     (setq c 0)
27. )(PutPy xcells 'item 1 1 (vl-princ-to-string Lit))
28. )
29. (vla-put-visible *appxls* 1)  ;;显示工作表
30.   ;; 保存工作簿为文件
31.   ;(vla-saveas wb "C:/Test.xlsx")
32. (vlax-release-object xcells)  ;;用完销毁
33. (vlax-release-object sht)
34. (vlax-release-object *appxls*)
35. )

复制代码