|
|
Lisp读取excel数据
(defun $get-excel-sheet-v-app$ (xlapp-old excelFile sheetName RangeStr
lst / arr col
col-zms cs DATA fullname
nm nms open? rg
row sh sheets-morens
shs ttt usedrange vvv
wb wbs xl xlsheet
release?
)
;读取excel数据
;excelFile xls文件路径
;xlapp-old app对象
;sheetName 表名字
;RangeStr 数据区域
;lst 很多参数可以放这里面
;($get-excel-sheet-v$ "C:\\Users\\Administrator\\Desktop\\11.20v1.1.xls" "Sheet1" "A1:B6")
(if (and xlapp-old
(vl-catch-all-error-p
(vl-catch-all-apply
'vlax-get-property
(list xlapp-old 'activeworkbook)
)
)
)
(setq xlapp-old nil)
)
(if (and (not xlapp-old) ;没有excel对象
(not excelFile) ;没有传入路径
sheetName ;但是，有seet的表名字
)
(if (and (setq xl ($xlapp-New$ nil nil nil))
(not (vl-catch-all-error-p xl))
(setq xlsheet
(vl-catch-all-apply
'vlax-get-property
(list (vl-catch-all-apply
'vlax-get-property
(list (vl-catch-all-apply
'vlax-get-property
(list xl 'activeworkbook)
)
'Sheets
)
)
'Item
sheetName
)
)
)
(not (vl-catch-all-error-p xlsheet))
)
()
(setq xl nil)
)
)
(or (and sheetName
(= (type sheetName) 'str)
) ;有值就必须是字串
(setq sheetName "Sheet1") ;无值时默认sheet1
)
(or (and RangeStr
(= (type RangeStr) 'str)
(wcmatch RangeStr "[,[A-Z]*`:[A-Z]*,]")
) ;要么有值
(setq RangeStr nil) ;要么没值，下面程序自动获取可用区域
)
(or (and xlapp-old
(not (vl-catch-all-error-p xlapp-old))
(setq xl xlapp-old)
)
(setq xl ($xlapp-New$ nil nil nil))
)
;创建excel程序对象
(IF (or (NOT XL) (vl-catch-all-error-p XL))
(PROGN
"
请检查注册表中以下两项的值是否正确
HKEY_CLASSES_ROOT\\Excel.Application\\CLSID
HKEY_CLASSES_ROOT\\CLSID\\{00024500-0000-0000-C000-000000000046}\\LocalServer32
"
)
)
(AND (NOT (vl-catch-all-error-p XL))
(setq wbs (vlax-get-property xl "WorkBooks"))
)
;获取excel程序对象的工作簿集合对象
(or (and XL
(not excelFile) ;没有传入路径
(NOT (vl-catch-all-error-p XL))
(setq wb (vlax-get-property XL 'activeworkbook))
;工作薄对象
(NOT (vl-catch-all-error-p wb))
) ;如果这里成立说明文件处于打开状态
(and XL
(NOT (vl-catch-all-error-p XL))
(setq wb (vlax-get-property XL 'activeworkbook))
;工作薄对象
(NOT (vl-catch-all-error-p wb))
(setq fullname (vlax-get-property wb 'fullname))
;完整路径
(NOT (vl-catch-all-error-p fullname))
excelFile
(= excelFile fullname) ;等于传入进来的路径
) ;如果这里成立说明文件处于打开状态
(AND wbs
(NOT (vl-catch-all-error-p wbs))
(setq wb (vl-catch-all-apply
'vlax-invoke-method
(list wbs "open" excelFile)
)
)
(setq open? 't)
)
) ;用工作簿集合对象打开指定的excel文件
(AND wb
(NOT (vl-catch-all-error-p wb))
(setq
shs
(vl-catch-all-apply 'vlax-get-property (list wb "Sheets"))
)
)
;获取刚才打开工作簿的所有工作表
(if xlsheet
(setq sh xlsheet)
(if (AND shs (NOT (vl-catch-all-error-p shs)))
(setq sh (vl-catch-all-apply
'vlax-get-property
(list (vl-catch-all-apply
'vlax-get-property
(list (vl-catch-all-apply
'vlax-get-property
(list xl 'activeworkbook)
)
'Sheets
)
)
'Item
sheetName
)
)
)
) ;获取指定的sheet表
)
(if (not RangeStr)
(or (and sh
(NOT (vl-catch-all-error-p sh))
(setq UsedRange (vlax-get-property SH 'UsedRange))
(setq col (vlax-get-property
(vlax-get-property UsedRange 'columns)
'count
)
)
(setq row (vlax-get-property
(vlax-get-property UsedRange 'rows)
'count
)
)
(setq col-zms ($26个字母任意组合$ col))
(setq RangeStr (strcat (car col-zms)
"1:"
(last col-zms)
(itoa row)
)
)
)
(setq RangeStr "A1:Z65535")
)
) ;如果没有传入区域字串就获取可使用区域
(setq rg (vl-catch-all-apply
'vlax-get-property
(list sh "Range" RangeStr)
)
)
;用指定的字符串创建工作表范围对象
(AND rg
(NOT (vl-catch-all-error-p rg))
(setq
vvv
(vl-catch-all-apply 'vlax-get-property (list rg 'Value))
)
)
;获取范围对象的值
(AND vvv
(NOT (vl-catch-all-error-p vvv))
(setq arr (vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value vvv))
)
)
)
;转换为数组
(if open?
(if (and xlapp-old (not (vl-catch-all-error-p xlapp-old)))
()
(if (= (cdr (assoc "强制返回excel对象" lst)) "是")
()
(progn
(function (lambda () (vlax-invoke-method wb "Close")))
;关闭工作簿
(vl-catch-all-apply
(function (lambda () (vlax-invoke-method xl "Quit")))
) ;退出excel对象
)
)
)
)
(if (and xlapp-old (not (vl-catch-all-error-p xlapp-old)))
() ;如果有传入xlapp-old对象，说明上级调用的时候已经获取到对象了，这里不能给释放掉，一旦释放了，上级调用方就出问题了
(if (= (cdr (assoc "强制返回excel对象" lst)) "是")
()
(progn
(vl-catch-all-apply
(function (lambda () (vlax-release-object sh)))
) ;释放sh对象
(vl-catch-all-apply
(function (lambda () (vlax-release-object wb)))
) ;释放wb对象
(vl-catch-all-apply
(function (lambda () (vlax-release-object xl)))
) ;释放excel对象
(setq release? 't) ;释放记号
)
)
)
(IF (AND arr (NOT (vl-catch-all-error-p arr)))
(SETQ
DATA
(mapcar
(function
(lambda (a /)
(mapcar
(function
(lambda (b / str)
(setq str
(vl-catch-all-apply 'vlax-variant-value (list b))
)
(if (vl-catch-all-error-p str)
(progn (print)
(princ (strcat "Excel返回错误: "
(vl-catch-all-error-message str)
)
)
(setq str "")
)
)
(or str
(setq str "")
)
str
)
)
a
)
)
)
arr
)
)
)
(if release?
(list
(cons "excel对象" nil)
(cons "数据" DATA)
(cons
"备注"
"传入有效xlapp对象，返回有效的xlapp对象；未传入或者是传入不合法的xlapp将不返回xlapp对象；但是，如果在lst里面传入“强制返回excel对象”的值为“是”的时候会强制将excel的对象给返回去"
)
) ;仅返回数据给上级
(list (cons "excel对象" xl) (cons "数据" DATA))
;返回xlapp对象和数据
)
) |
|
发表于 2024-6-22 09:46:18
