社区 › AutoLISP/Visual LISP 编程技术 › VLISP获取EXCEL_XLS文件对象

xtjd 发表于 2024-8-31 15:25:08

VLISP获取EXCEL_XLS文件对象

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

;例
;(setq newbook(xtjd:openxls "Xtjd_Pgp.Xls"))

;关闭excel
(defun xtjd:CloseExcel()
;如需保存建议先用(vla-save newbook)
(if *openxls*(vlax-invoke-method newbook 'Close:vlax-False)) ;不保存关闭XLS文件
(if *openapp*(vlax-invoke-method *excelapp* 'QUIT))               ;EX新开，则关闭EX
(mapcar 'vlax-release-object (list *excelapp* *xlswbs*))             ;释放对象
)
VLISP获取EXCEL_XLS文件对象
xls文件已经打开，直接返回xls对象
xls文件未打开，则打开并返回对象

黄翔 发表于 2024-9-9 11:44:48

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

xtjd 发表于 2024-9-10 14:54:41

(defun xtjd:openxls(xls / exappstr fn fn2 fnv newopen)
;返回xls文件对象名称 如xls文件不在支持目录里需加上路径
;全局变量
;*openapp*   excel程序开启标记
;*openxls*   xls文件开启标记
;*excelapp*excel程序对象
;*xlswbs*    xls对象
(defun newopen(file)
    ;新开XLS文档，并返回打开的xls文件对象名称
    (setq *openxls* t) ;xls文件开启标记
    (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示
    (vlax-invoke-method *xlswbs* "open" file);打开xls文件
)

(if(setq fn(findfile xls))
    (progn
      ;excel程序，下述简称EX
      (setqexappstr "Excel.Application")
      ;判断EX是否打开，打开则返回对象名称
      (if(setq *excelapp*(vlax-get-object exappstr))
      
      ;EX已打开
      (progn
          (setq
            ;获取fn真实对应的文件名称fn2(大小写与实际显示一致)
            fn2(car(vl-directory-files(vl-filename-directory fn)(strcat(vl-filename-base fn)(vl-filename-extension fn))1))
            ;已打开的文档集合
            *xlswbs*(vlax-get-property *excelapp* "workbooks")
          )
          ;判断文档数目是否为0
          (if(zerop(vla-get-count *xlswbs*))
            ;为0，新开xls文件fn并返回fn的xls对象名
            (setq fnv(newopen fn))
            ;不为0 且获取fn文件对象名失败 则新开fn文件并返回xls对象名
            (if(vl-catch-all-error-p(setq fnv(vl-catch-all-apply 'vlax-get-property(list *xlswbs* "item" fn2))))
            (setq fnv(newopen fn))
            (setq *openxls* nil)
            )
          )
      )
      
      ;EX未打开
      (setq
          *openapp* t ;EX开启标记
          *excelapp*(vlax-create-object exappstr) ;创建EX对象
          *xlswbs*(vlax-get-property *excelapp* "workbooks") ;workbooks
          fnv(newopen fn) ;新开xls文件并返回xls对象名
      )
      
      )
    )
)
fnv
)


(defun xtjd:openxls-2(xls / exappstr fn fn2 fnv newopen)
;返回xls文件对象名称 如xls文件不在支持目录里需加上路径
;全局变量
;*openapp*   excel程序开启标记
;*openxls*   xls文件开启标记
;*excelapp*excel程序对象
;*xlswbs*    xls对象
(defun newopen(file)
    ;新开XLS文档，并返回打开的xls文件对象名称
    (setq *openxls* t) ;xls文件开启标记
    (vla-put-visible *excelapp* :vlax-False) ;程序对象不显示
    (vlax-invoke-method *xlswbs* "open" file);打开xls文件
)

(if(setq fn(findfile xls))
    (progn
      ;excel程序，下述简称EX
      (setqexappstr "Excel.Application")
      ;判断EX是否打开，打开则返回对象名称
      (if(setq *excelapp*(vlax-get-object exappstr))
      
      ;EX已打开
      (progn
          ;已开文档集合
          (setq *xlswbs*(vlax-get-property *excelapp* "workbooks"))
          ;判断文档数目是否为0
          (if(zerop(vla-get-count *xlswbs*))
            ;为0，新开xls文件fn并返回fn的xls对象名
            (setq fnv(newopen fn))
            ;如果文档数目不为0，则对比文档中文件全名(含路径大写)
            (progn
            ;函数应用到所有集合对象
            (vlax-map-collection
                *xlswbs*
                '(lambda(x)
                   ;如果比对成功，则获取fn的xls对象名
                   (if(eq(strcase(vla-get-FullName x))(strcase fn))
                     (setq *openxls* nil fnv x)
                   )
               )
            )
            ;如果集中合未找到fn，则新开fn并返回对象名称
            (or fnv(setq fnv(newopen fn)))
            )
          )
      )
      
      ;EX未打开
      (setq
          *openapp* t ;EX开启标记
          *excelapp*(vlax-create-object exappstr) ;创建EX对象
          *xlswbs*(vlax-get-property *excelapp* "workbooks") ;workbooks
          fnv(newopen fn) ;新开xls文件并返回xls对象名
      )
      
      )
    )
)
fnv
)

;例
;(setq newbook(xtjd:openxls "Xtjd_Pgp.Xls"))
;(setq newbook(xtjd:openxls-2 "Xtjd_Pgp.Xls"))

cds15980954301 发表于 2024-9-12 14:51:40

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

nihaogemen 发表于 2024-9-13 10:06:12

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

xyp1964 发表于 2024-9-14 22:42:29

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

查看完整版本: VLISP获取EXCEL_XLS文件对象