VLISP获取EXCEL_XLS文件对象

xtjd

2. (defun xtjd:openxls(xls / exappstr fn fn2 fnv newopen)
   
3.   ;返回xls文件对象名称 如xls文件不在支持目录里需加上路径
   
4.   ;全局变量
   
5.   ;*openapp*   excel程序开启标记
   
6.   ;*openxls*   xls文件开启标记
   
7.   ;*excelapp*  excel程序对象
   
8.   ;*xlswbs*    xls对象称
   
9.   (defun newopen()
   
10.     ;新开XLS文档，并返回打开的xls文件对象名称
    
11.     (setq *openxls* t) ;xls文件开启标记
    
12.     (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示
    
13.     (vlax-invoke-method *xlswbs* "open" fn)  ;打开xls文件
    
14.   )
    
15.   (if(setq fn(findfile xls))
    
16.     (progn
    
17.       (setq  exappstr "Excel.Application")          ;excel程序，下述简称EX
    
18.       (if(setq *excelapp*(vlax-get-object exappstr)) ;EX已打开 返回对象名称
    
19.         (progn ;EX已打开
    
20.           (setq ;fn2 = 与实际文件名称大小写一致
    
21.             fn2(car(vl-directory-files(vl-filename-directory fn)(strcat(vl-filename-base fn)(vl-filename-extension fn))1))
    
22.             *xlswbs*(vlax-get-property *excelapp* "workbooks") ;已打开的文档集合
    
23.           )
    
24.           (if(zerop(vla-get-count *xlswbs*))
    
25.             (setq fnv(newopen)) ;打开的文档数目=0 则新开xls文件并返回xls对象名
    
26.             ;打开的文档数目>0 获取xls文件的对象名失败 则新开xls文件并返回xls对象名
    
27.             (if(vl-catch-all-error-p(setq fnv(vl-catch-all-apply 'vlax-get-property(list *xlswbs* "item" fn2))))
    
28.               (setq fnv(newopen))
    
29.               (setq *openxls* nil)
    
30.             )
    
31.           )
    
32.         )
    
33.         (setq                                   
    
34.           *openapp* t                                                               ;EX开启标记
    
35.           *excelapp*(vlax-create-object exappstr)                     ;创建EX对象
    
36.           *xlswbs*(vlax-get-property *excelapp* "workbooks")  ;workbooks
    
37.           fnv(newopen)                                                             ;新开xls文件并返回xls对象名
    
38.         )
    
39.       )
    
40.     )
    
41.   )
    
42.   fnv
    
43. )
    
44. 
    
45. ;例
    
46. ;(setq newbook(xtjd:openxls "Xtjd_Pgp.Xls"))
    
47. 
    
48. ;关闭excel
    
49. (defun xtjd:CloseExcel()
    
50.   ;如需保存建议先用(vla-save newbook)
    
51.   (if *openxls*(vlax-invoke-method newbook 'Close  :vlax-False)) ;不保存关闭XLS文件
    
52.   (if *openapp*(vlax-invoke-method *excelapp* 'QUIT))               ;EX新开，则关闭EX
    
53.   (mapcar 'vlax-release-object (list *excelapp* *xlswbs*))             ;释放对象
    
54. )
    

(defun xtjd:openxls(xls / exappstr fn fn2 fnv newopen)<br />   ;返回xls文件对象名称 如xls文件不在支持目录里需加上路径<br />   ;全局变量<br />   ;*openapp*   excel程序开启标记<br />   ;*openxls*   xls文件开启标记<br />   ;*excelapp*  excel程序对象<br />   ;*xlswbs*    xls对象称<br />   (defun newopen()<br />     ;新开XLS文档，并返回打开的xls文件对象名称<br />     (setq *openxls* t) ;xls文件开启标记<br />     (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示<br />     (vlax-invoke-method *xlswbs* "open" fn)  ;打开xls文件<br />   )<br />   (if(setq fn(findfile xls))<br />     (progn<br />       (setq  exappstr "Excel.Application")          ;excel程序，下述简称EX<br />       (if(setq *excelapp*(vlax-get-object exappstr)) ;EX已打开 返回对象名称<br />         (progn ;EX已打开<br />           (setq ;fn2 = 与实际文件名称大小写一致<br />             fn2(car(vl-directory-files(vl-filename-directory fn)(strcat(vl-filename-base fn)(vl-filename-extension fn))1))<br />             *xlswbs*(vlax-get-property *excelapp* "workbooks") ;已打开的文档集合<br />           )<br />           (if(zerop(vla-get-count *xlswbs*))<br />             (setq fnv(newopen)) ;打开的文档数目=0 则新开xls文件并返回xls对象名<br />             ;打开的文档数目>0 获取xls文件的对象名失败 则新开xls文件并返回xls对象名<br />             (if(vl-catch-all-error-p(setq fnv(vl-catch-all-apply 'vlax-get-property(list *xlswbs* "item" fn2))))<br />               (setq fnv(newopen))<br />               (setq *openxls* nil)<br />             )<br />           )<br />         )<br />         (setq                                   <br />           *openapp* t                                                               ;EX开启标记<br />           *excelapp*(vlax-create-object exappstr)                     ;创建EX对象<br />           *xlswbs*(vlax-get-property *excelapp* "workbooks")  ;workbooks<br />           fnv(newopen)                                                             ;新开xls文件并返回xls对象名<br />         )<br />       )<br />     )<br />   )<br />   fnv<br /> )<br /> <br /> ;例<br /> ;(setq newbook(xtjd:openxls "Xtjd_Pgp.Xls"))<br /> <br /> ;关闭excel<br /> (defun xtjd:CloseExcel()<br />   ;如需保存建议先用(vla-save newbook)<br />   (if *openxls*(vlax-invoke-method newbook 'Close  :vlax-False)) ;不保存关闭XLS文件 <br />   (if *openapp*(vlax-invoke-method *excelapp* 'QUIT))               ;EX新开，则关闭EX<br />   (mapcar 'vlax-release-object (list *excelapp* *xlswbs*))             ;释放对象<br /> )<br />

VLISP获取EXCEL_XLS文件对象
xls文件已经打开，直接返回xls对象
xls文件未打开，则打开并返回对象

黄翔

这么好的帖子.没人回复..

xtjd

2. (defun xtjd:openxls(xls / exappstr fn fn2 fnv newopen)
   
3.   ;返回xls文件对象名称 如xls文件不在支持目录里需加上路径
   
4.   ;全局变量
   
5.   ;*openapp*   excel程序开启标记
   
6.   ;*openxls*   xls文件开启标记
   
7.   ;*excelapp*  excel程序对象
   
8.   ;*xlswbs*    xls对象
   
9.   (defun newopen(file)
   
10.     ;新开XLS文档，并返回打开的xls文件对象名称
    
11.     (setq *openxls* t) ;xls文件开启标记
    
12.     (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示
    
13.     (vlax-invoke-method *xlswbs* "open" file)  ;打开xls文件
    
14.   )
    
15.   
    
16.   (if(setq fn(findfile xls))
    
17.     (progn
    
18.       ;excel程序，下述简称EX
    
19.       (setq  exappstr "Excel.Application")
    
20.       ;判断EX是否打开，打开则返回对象名称
    
21.       (if(setq *excelapp*(vlax-get-object exappstr))
    
22.         
    
23.         ;EX已打开
    
24.         (progn
    
25.           (setq
    
26.             ;获取fn真实对应的文件名称fn2(大小写与实际显示一致)
    
27.             fn2(car(vl-directory-files(vl-filename-directory fn)(strcat(vl-filename-base fn)(vl-filename-extension fn))1))
    
28.             ;已打开的文档集合
    
29.             *xlswbs*(vlax-get-property *excelapp* "workbooks")
    
30.           )
    
31.           ;判断文档数目是否为0
    
32.           (if(zerop(vla-get-count *xlswbs*))
    
33.             ;为0，新开xls文件fn并返回fn的xls对象名
    
34.             (setq fnv(newopen fn))
    
35.             ;不为0 且获取fn文件对象名失败 则新开fn文件并返回xls对象名
    
36.             (if(vl-catch-all-error-p(setq fnv(vl-catch-all-apply 'vlax-get-property(list *xlswbs* "item" fn2))))
    
37.               (setq fnv(newopen fn))
    
38.               (setq *openxls* nil)
    
39.             )
    
40.           )
    
41.         )
    
42.         
    
43.         ;EX未打开
    
44.         (setq
    
45.           *openapp* t ;EX开启标记
    
46.           *excelapp*(vlax-create-object exappstr) ;创建EX对象
    
47.           *xlswbs*(vlax-get-property *excelapp* "workbooks") ;workbooks
    
48.           fnv(newopen fn) ;新开xls文件并返回xls对象名
    
49.         )
    
50.         
    
51.       )
    
52.     )
    
53.   )
    
54.   fnv
    
55. )
    
56. 
    
57. 
    
58. (defun xtjd:openxls-2(xls / exappstr fn fn2 fnv newopen)
    
59.   ;返回xls文件对象名称 如xls文件不在支持目录里需加上路径
    
60.   ;全局变量
    
61.   ;*openapp*   excel程序开启标记
    
62.   ;*openxls*   xls文件开启标记
    
63.   ;*excelapp*  excel程序对象
    
64.   ;*xlswbs*    xls对象
    
65.   (defun newopen(file)
    
66.     ;新开XLS文档，并返回打开的xls文件对象名称
    
67.     (setq *openxls* t) ;xls文件开启标记
    
68.     (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示
    
69.     (vlax-invoke-method *xlswbs* "open" file)  ;打开xls文件
    
70.   )
    
71.   
    
72.   (if(setq fn(findfile xls))
    
73.     (progn
    
74.       ;excel程序，下述简称EX
    
75.       (setq  exappstr "Excel.Application")
    
76.       ;判断EX是否打开，打开则返回对象名称
    
77.       (if(setq *excelapp*(vlax-get-object exappstr))
    
78.         
    
79.         ;EX已打开
    
80.         (progn
    
81.           ;已开文档集合
    
82.           (setq *xlswbs*(vlax-get-property *excelapp* "workbooks"))
    
83.           ;判断文档数目是否为0
    
84.           (if(zerop(vla-get-count *xlswbs*))
    
85.             ;为0，新开xls文件fn并返回fn的xls对象名
    
86.             (setq fnv(newopen fn))
    
87.             ;如果文档数目不为0，则对比文档中文件全名(含路径大写)
    
88.             (progn
    
89.               ;函数应用到所有集合对象
    
90.               (vlax-map-collection
    
91.                 *xlswbs*
    
92.                 '(lambda(x)
    
93.                    ;如果比对成功，则获取fn的xls对象名
    
94.                    (if(eq(strcase(vla-get-FullName x))(strcase fn))
    
95.                      (setq *openxls* nil fnv x)
    
96.                    )
    
97.                  )
    
98.               )
    
99.               ;如果集中合未找到fn，则新开fn并返回对象名称
    
100.               (or fnv(setq fnv(newopen fn)))
     
101.             )
     
102.           )
     
103.         )
     
104.         
     
105.         ;EX未打开
     
106.         (setq
     
107.           *openapp* t ;EX开启标记
     
108.           *excelapp*(vlax-create-object exappstr) ;创建EX对象
     
109.           *xlswbs*(vlax-get-property *excelapp* "workbooks") ;workbooks
     
110.           fnv(newopen fn) ;新开xls文件并返回xls对象名
     
111.         )
     
112.         
     
113.       )
     
114.     )
     
115.   )
     
116.   fnv
     
117. )
     
118. 
     
119. ;例
     
120. ;(setq newbook(xtjd:openxls "Xtjd_Pgp.Xls"))
     
121. ;(setq newbook(xtjd:openxls-2 "Xtjd_Pgp.Xls"))
     

(defun xtjd:openxls(xls / exappstr fn fn2 fnv newopen)<br />   ;返回xls文件对象名称 如xls文件不在支持目录里需加上路径<br />   ;全局变量<br />   ;*openapp*   excel程序开启标记<br />   ;*openxls*   xls文件开启标记<br />   ;*excelapp*  excel程序对象<br />   ;*xlswbs*    xls对象<br />   (defun newopen(file)<br />     ;新开XLS文档，并返回打开的xls文件对象名称<br />     (setq *openxls* t) ;xls文件开启标记<br />     (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示<br />     (vlax-invoke-method *xlswbs* "open" file)  ;打开xls文件<br />   )<br />   <br />   (if(setq fn(findfile xls))<br />     (progn<br />       ;excel程序，下述简称EX<br />       (setq  exappstr "Excel.Application")<br />       ;判断EX是否打开，打开则返回对象名称<br />       (if(setq *excelapp*(vlax-get-object exappstr))<br />         <br />         ;EX已打开<br />         (progn<br />           (setq<br />             ;获取fn真实对应的文件名称fn2(大小写与实际显示一致)<br />             fn2(car(vl-directory-files(vl-filename-directory fn)(strcat(vl-filename-base fn)(vl-filename-extension fn))1))<br />             ;已打开的文档集合<br />             *xlswbs*(vlax-get-property *excelapp* "workbooks")<br />           )<br />           ;判断文档数目是否为0<br />           (if(zerop(vla-get-count *xlswbs*))<br />             ;为0，新开xls文件fn并返回fn的xls对象名<br />             (setq fnv(newopen fn))<br />             ;不为0 且获取fn文件对象名失败 则新开fn文件并返回xls对象名<br />             (if(vl-catch-all-error-p(setq fnv(vl-catch-all-apply 'vlax-get-property(list *xlswbs* "item" fn2))))<br />               (setq fnv(newopen fn))<br />               (setq *openxls* nil)<br />             )<br />           )<br />         )<br />         <br />         ;EX未打开<br />         (setq<br />           *openapp* t ;EX开启标记<br />           *excelapp*(vlax-create-object exappstr) ;创建EX对象<br />           *xlswbs*(vlax-get-property *excelapp* "workbooks") ;workbooks<br />           fnv(newopen fn) ;新开xls文件并返回xls对象名<br />         )<br />         <br />       )<br />     )<br />   )<br />   fnv<br /> )<br /> <br /> <br /> (defun xtjd:openxls-2(xls / exappstr fn fn2 fnv newopen)<br />   ;返回xls文件对象名称 如xls文件不在支持目录里需加上路径<br />   ;全局变量<br />   ;*openapp*   excel程序开启标记<br />   ;*openxls*   xls文件开启标记<br />   ;*excelapp*  excel程序对象<br />   ;*xlswbs*    xls对象<br />   (defun newopen(file)<br />     ;新开XLS文档，并返回打开的xls文件对象名称<br />     (setq *openxls* t) ;xls文件开启标记<br />     (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示<br />     (vlax-invoke-method *xlswbs* "open" file)  ;打开xls文件<br />   )<br />   <br />   (if(setq fn(findfile xls))<br />     (progn<br />       ;excel程序，下述简称EX<br />       (setq  exappstr "Excel.Application") <br />       ;判断EX是否打开，打开则返回对象名称<br />       (if(setq *excelapp*(vlax-get-object exappstr))<br />         <br />         ;EX已打开<br />         (progn<br />           ;已开文档集合<br />           (setq *xlswbs*(vlax-get-property *excelapp* "workbooks")) <br />           ;判断文档数目是否为0<br />           (if(zerop(vla-get-count *xlswbs*))<br />             ;为0，新开xls文件fn并返回fn的xls对象名<br />             (setq fnv(newopen fn))<br />             ;如果文档数目不为0，则对比文档中文件全名(含路径大写)<br />             (progn<br />               ;函数应用到所有集合对象<br />               (vlax-map-collection<br />                 *xlswbs* <br />                 '(lambda(x)<br />                    ;如果比对成功，则获取fn的xls对象名<br />                    (if(eq(strcase(vla-get-FullName x))(strcase fn))<br />                      (setq *openxls* nil fnv x)<br />                    )<br />                  )<br />               )<br />               ;如果集中合未找到fn，则新开fn并返回对象名称<br />               (or fnv(setq fnv(newopen fn)))<br />             )<br />           )<br />         )<br />         <br />         ;EX未打开<br />         (setq<br />           *openapp* t ;EX开启标记<br />           *excelapp*(vlax-create-object exappstr) ;创建EX对象<br />           *xlswbs*(vlax-get-property *excelapp* "workbooks") ;workbooks<br />           fnv(newopen fn) ;新开xls文件并返回xls对象名<br />         )<br />         <br />       )<br />     )<br />   )<br />   fnv<br /> )<br /> <br /> ;例<br /> ;(setq newbook(xtjd:openxls "Xtjd_Pgp.Xls"))<br /> ;(setq newbook(xtjd:openxls-2 "Xtjd_Pgp.Xls"))<br />

cds15980954301

其他xls文件如有打开，关闭时也会跟着一起关闭

nihaogemen

有没有lisp读取写入已经打开的excel文件的示例，指教一下。
每次要关掉excel太麻烦

xyp1964

1. (defun c:aa ()
   
2.   (if (setq xls (vlax-create-object "excel.application"))
   
3.     (progn
   
4.       (vlax-invoke-method (vlax-get-property xls 'WorkBooks) 'Add)
   
5.       (vla-put-visible xls 1)
   
6.       (setq aw (vlax-get xls 'ActiveWorkbook)
   
7.             as (vlax-get aw 'ActiveSheet)
   
8.             aa (vlax-get-property as "range" "D4")
   
9.       )
   
10.       (vlax-put aa 'Formula "中秋节快乐!")
    
11.       (vlax-put (vlax-get aa 'Borders) 'Value 1) ; 单元格加边框
    
12.       (vlax-put (vlax-get aa 'Font) 'ColorIndex 3) ; 单元格字体颜色 0自动1红色3绿色6黄
    
13.       (vlax-put (vlax-get aa 'Interior) 'ColorIndex 6) ; 单元格背景颜色 0自动1红色3绿色6黄
    
14.       (setq bb (vlax-get (vlax-get (vlax-get as 'usedrange) 'cells)'columns))
    
15.       (vlax-invoke-method bb 'autofit); 自动调整宽度
    
16.     )
    
17.   )
    
18.   (princ)
    
19. )

(defun c:aa ()<br />   (if (setq xls (vlax-create-object "excel.application"))<br />     (progn<br />       (vlax-invoke-method (vlax-get-property xls 'WorkBooks) 'Add)<br />       (vla-put-visible xls 1)<br />       (setq aw (vlax-get xls 'ActiveWorkbook)<br />             as (vlax-get aw 'ActiveSheet)<br />             aa (vlax-get-property as "range" "D4")<br />       )<br />       (vlax-put aa 'Formula "中秋节快乐!")<br />       (vlax-put (vlax-get aa 'Borders) 'Value 1) ; 单元格加边框<br />       (vlax-put (vlax-get aa 'Font) 'ColorIndex 3) ; 单元格字体颜色 0自动1红色3绿色6黄<br />       (vlax-put (vlax-get aa 'Interior) 'ColorIndex 6) ; 单元格背景颜色 0自动1红色3绿色6黄<br />       (setq bb (vlax-get (vlax-get (vlax-get as 'usedrange) 'cells)'columns))<br />       (vlax-invoke-method bb 'autofit); 自动调整宽度<br />     )<br />   )<br />   (princ)<br /> )