[LISP程序]：VLISP操作EXCEL函数库大全..

舟自横 · 发表于 2005-3-26 16:08:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;;;;;;此為經整理過后一些VLISP調用EXCEL常用公共函數;;;;;;;;;;;;
;;;;;;;;此為私人函數未經許可請勿...............................
;;;;;;;;開發:朱衛星 2005/02/22 rev01............................
;;;;;;;;it's the first!ok!used in acad at least rev. 2000;;;;;;;
(Defun vlxls-variant->list (VarX / Run Item Rtn)
(setq Run T)
(while Run
(cond ((= (type VarX) 'SAFEARRAY)
(setq VarX (vlax-safearray->list VarX)))
((= (type VarX) 'VARIANT)
(if (member (vlax-variant-type VarX) (list 5 4 3 2))
(setq VarX (vlax-variant-change-type Varx vlax-vbString)))
(setq VarX (vlax-variant-value VarX)))
(t (setq Run nil)))
)
(cond ((= (type VarX) 'LIST)
(foreach Item VarX
(setq Item (vlxls-variant->list Item) Rtn (append Rtn (list Item))
)
)
)
((= VarX nil) (setq Rtn ""))
(t (setq Rtn VarX)))
Rtn)
(Defun vlxls-color-ECI->truecolor (Color / Rtn)
(if (setq Rtn (cdr (assoc Color *xls-color*)))
(setq Rtn (nth 1 Rtn)))
(if (null Rtn)
(setq Rtn 16711935)
)Rtn
)
;;;EXAMPLE:
;;;(vlxls-color-eci->truecolor 0)return: 16711935
;;;(vlxls-color-eci->truecolor 1)return: 0
;;;(vlxls-color-eci->truecolor 12)return: 8355584
;;;(vlxls-color-eci->truecolor 120)return: 16711935
(Defun vlxls-color-eci->aci (Color / Rtn)
(if (null (setq Rtn (cdr (assoc Color *xls-color*))))
(setq Rtn 256)
(setq Rtn (nth 0 Rtn))
)
Rtn)
;;;EXAMPLE:
;;;(vlxls-color-eci->aci 0)return: 256
;;;(vlxls-color-eci->aci 1)return: 18
;;;(vlxls-color-eci->aci 12)return: 56
;;;(vlxls-color-eci->aci 120)return: 256
(Defun vlxls-color-aci->eci (Color / Item Rtn)
(foreach Item *xls-color*
(if (= (nth 1 Item) Color)
(setq Rtn (car Item)))
)
(if (null Rtn)
(setq Rtn 0))
Rtn
)
;;;Examples:
;;;(vlxls-color-aci->eci 0)return: 0
;;;(vlxls-color-aci->eci 1)return: 3
;;;(vlxls-color-aci->eci 12)return: 0
;;;(vlxls-color-aci->eci 120)return: 0
(Defun vlxls-color-aci->truecolor (aci)
(vlxls-color-eci->truecolor (vlxls-color-aci->eci aci))
)
;;;Examples:
;;;(vlxls-color-aci-> truecolor 0) return: 16711935
;;;(vlxls-color-aci->truecolor 1) return: 16711680
;;;(vlxls-color-aci-> truecolor 12)return: 16711935
;;;(vlxls-color-aci-> truecolor 120)return: 16711935
;;;OK!NOW LET'S GO! START EXCEL.APPLICATION!!............
;;;before use these program you should install "Microsoft Excel" in your computer!!
;;;if not,you will recicieve an error messege!!
;;;such as "warning:........."! ZWX 2005/02/22 COPYRIGHT .....
(Defun vlxls-app-Init (/ OSVar GGG Olb8 Olb9 Olb10 TLB Out msg msg1 msg2)
;;;;;;;;;;該程序實現了初始化EXCEL應用程序!
(if *Chinese*
(setq msg "\n 初始化微軟Excel "
msg1 "\042初始化Excel失敗\042"
msg2 (strcat "\042 警告""\n ====""\n 無法在您的計算机上檢測到微軟Excel軟件"
"\n 如果您确認已經安裝Excel, 請發送電子郵"
"\n 件到yota@ikozmos.com獲取更多的解決方案\042"))
(setq msg "\n Initializing Microsoft Excel "
msg1 "\042Initialization Error\042"
msg2 (strcat "\042 WARNING""\n ======="
"\n Can NOT detect Excel97/200X/XP in your computer"
"\n If you already have Excel installed, please email"
"\n us to get more solution via [email]yota@ikozmos.com[/email]\042"))
)
(if (null msxl-xl24HourClock)
(progn (if (and (setq GGG (vl-registry-read
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\Excel.EXE"
"Path"))
(setq GGG (strcase (strcat GGG "Excel.EXE"))))
(progn (foreach OSVar (list "SYSTEMROOT" "WINDIR""WINBOOTDIR" "SYSTEMDRIVE"
"USERNAME" "COMPUTERNAME" "HOMEDRIVE" "HOMEPATH" "PROGRAMFILES")
(if (vl-string-search (strcat "%" OSVar "%") GGG)
(setq GGG (vl-string-subst (strcase (getenv OSVar))
(strcat "%" OSVar "%")GGG)))
)
(setq Olb8 (findfile (vl-string-subst "EXCEL8.OLB" "EXCEL.EXE" GGG))
Olb9 (findfile (vl-string-subst "EXCEL9.OLB" "EXCEL.EXE" GGG))
Olb10 (findfile (vl-string-subst "EXCEL10.OLB" "EXCEL.EXE" GGG)))
(cond ((= (vl-filename-base (vl-filename-directory GGG))"OFFICE11")
(setq TLB GGG Out "2003"))
((= (vl-filename-base (vl-filename-directory GGG))
"OFFICE10")
(setq TLB GGG Out "XP"))
(Olb9 (setq TLB Olb9 Out "2000"))
(Olb8 (setq TLB Olb8 Out "97"))
(t (setq Out "Version Unknown"))
)
(if TLB (progn (princ (strcat MSG Out "..."))
(vlax-import-type-library
:tlb-filename TLB
:methods-prefix "msxl-"
:properties-prefix "msxl-"
:constants-prefix "msxl-"))
)
)(progn (if vldcl-msgbox
(vldcl-msgbox "x" msg1 msg2)
(alert (read msg2)))
(exit)))
)
)
msxl-xl24HourClock
)
;;;Examples:
;;;(vlxls-app-init) return: 33
(Defun vlxls-app-New (UnHide / Rtn)
;;;; 該程序實現功能:新建一個excel格
;;;;;;;;;; THIS PROGRAM CAN BUILD A NEW EXCELFILE
(if (vlxls-app-init)
(progn
(if *Chinese* (princ "\n 新建微軟Excel工作表...")
(princ "\n Creating new Excel Spreadsheet file..."))
(if (setq Rtn (vlax-get-or-create-object "Excel.Application"))
(progn (vlax-invoke-method
(vlax-get-property Rtn 'WorkBooks)
'Add)
(if UnHide (vla-put-visible Rtn 1)
(vla-put-visible Rtn 0))
)
)
)
)
Rtn
)
;;;Examples:
;;;(setq *xlapp* (vlxls-app-new T)) return: #<VLA-OBJECT _Application 001db27c>
(Defun vlxls-app-open(XLSFile UnHide / ExcelApp WorkSheet Sheets ActiveSheet Rtn)
;;;function: this program can open an excelfile
(setq XLSFile (strcase XLSFile))
(if (null (wcmatch XLSFile "*.XLS"))
(setq XLSFile (strcat XLSFile ".XLS")))
(if (and (findfile XLSFile)
(setq Rtn (vlax-get-or-create-object "Excel.Application")))
(progn (vlax-invoke-method (vlax-get-property Rtn 'WorkBooks)
'Open XLSFile)
(if UnHide
(vla-put-visible Rtn 1)
(vla-put-visible Rtn 0))))
Rtn)
;;;Examples:
;;;(setq *xlapp* (vlxls-app-open “C:/test.XLS” T)) e #<VLA-OBJECT _Application 001efd2c>
(Defun vlxls-app-save (xlapp)
;;;;保存文件
(equal (vlax-invoke-method
(vlax-get-property Xlapp "ActiveWorkbook")"Save")
:vlax-true)
)
;;;Examples:
;;;(vlxls-app-save *xlapp*) return: T
(Defun vlxls-app-saveas (xlapp Filename / Rtn);;;另存文件
(if (null filename)
(setq filename (strcat (getvar "dwgprefix") "XLS.XLS")))
(if (null (wcmatch (setq filename (strcase Filename)) "*.XLS"))
(setq filename (strcat filename ".XLS")))
(if (findfile Filename)
(vl-file-delete (findfile Filename))
)
(vlax-invoke-method
(vlax-get-property Xlapp "ActiveWorkbook")
"SaveAs"
Filename
msxl-xlNormal
""
""
:vlax-False
:vlax-False
nil
)
(findfile Filename)
)
;;;Examples:
;;;(vlxls-app-saveas *xlapp* nil) return: “C:/Temp-Folder/XLS.XLS”
;;;(vlxls-app-saveas *xlapp* “C:/Temp-Folder/XLS.XLS”) return: “C:/Temp-Folder/XLS.XLS”
;;;(vlxls-app-saveas *xlapp* nil) return: NIL
(Defun vlxls-app-quit (ExlObj SaveYN);;退出應用程序
(if SaveYN
(vlax-invoke-method
(vlax-get-property ExlObj "ActiveWorkbook")
'Close
)
(vlax-invoke-method
(vlax-get-property ExlObj "ActiveWorkbook")
'Close
:vlax-False
)
)
(vlax-invoke-method ExlObj 'QUIT)
(vlax-release-object ExlObj)
(setq ExlObj nil)
(gc)
)
;;;Examples:
;;;(vlxls-app-quit *xlapp* nil) return: nil
(Defun vlxls-app-kill (SaveYN / ExlObj);;;強行清除所有EXCEL應用程序
(while (setq ExlObj (vlax-get-object "Excel.Application"))
(vlxls-app-quit ExlObj SaveYN))
)
;;;Examples:
;;;(vlxls-app-kill T) return: nil
(Defun vlxls-app-autofit (xlapp / sh act Rtn);;;存儲格自動調整大小
(setq act (vlxls-Sheet-Get-Active xlapp))
(foreach sh (append (vl-remove act (vlxls-sheet-get-all Xlapp))
(list act))
(setq Rtn (variant-value (msxl-autofit
(msxl-get-columns
(msxl-get-Cells
(vlxls-sheet-get-usedrange xlapp sh))))))
)
(equal Rtn :vlax-true)
)
;;;Examples:
;;;(vlxls-app-autofit *xlapp*) return: T
;;;(vlxls-app-autofit *xlapp*) return: NIL
(Defun vlxls-sheet-get-all (xlapp / SH Rtn);;;;取得所有應用的頁
(vlax-for SH (vlax-get-property Xlapp "sheets")
(setq Rtn (cons (vlax-get-property sh "Name") Rtn))
)(reverse Rtn)
)
;;;Examples:
;;;(vlxls-sheet-get-all *xlapp*) e ("Sheet1" "Sheet2" "Sheet3")
(Defun vlxls-Sheet-Get-Active (xlapp);;;;返回當前應用的頁
(vlax-get-property (msxl-get-ActiveSheet Xlapp) 'name)
)
;;;Examples:
;;;(vlxls-sheet-get-active *xlapp*) return: "Sheet2"
(Defun vlxls-sheet-delete (xlapp Name / sh Rtn);;;刪除頁
(setq Rtn (vlxls-sheet-get-all Xlapp))
(vlax-for sh (vlax-get-property Xlapp "sheets")
(if (= (vlax-get-property sh "Name") Name)
(vlax-invoke-method sh "Delete"))
)
(not (equal Rtn (vlxls-sheet-get-all Xlapp)))
)
;;;Examples:
;;;(vlxls-sheet-delete *xlapp* “Sheet1”) return: T
;;;(vlxls-sheet-delete *xlapp* “UnExistingSheet”) return: NIL
(Defun vlxls-sheet-rename (New Old Xlapp / sh Rtn);;;給頁重新命名
(if (null old)
(setq old (msxl-get-name (msxl-get-activesheet Xlapp))))
(if (member New (vlxls-sheet-get-all Xlapp))
(setq Rtn nil)
(progn (vlax-for sh (vlax-get-property Xlapp "sheets")
(if (= (msxl-get-name sh) Old)
(msxl-put-name sh New)))
(setq Rtn (equal New (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'name)))
)
)
Rtn
)
;;;Examples:
;;;(vlxls-sheet-rename “New” “Sheet1” *xlapp*) return: T
;;;(vlxls-sheet-rename “New” NIL *xlapp*) return: T
;;;(vlxls-sheet-rename “Sheet3” NIL *xlapp*) return: NIL
;;;(vlxls-sheet-rename “Sheet2” “Sheet1” *xlapp*) return: NIL
;;;(vlxls-sheet-rename “Sheet2” “UnExistSheet” *xlapp*) return: NIL
(Defun vlxls-sheet-add (xlapp Name / Rtn);;;增加頁
(if (member name (vlxls-sheet-get-all xlapp))
(setq Rtn nil)
(progn (vlax-put-property
(vlax-invoke-method
(vlax-get-property Xlapp "sheets") "Add")
"name" Name)
(setq Rtn (equal (vlxls-sheet-get-active xlapp) name))
))
Rtn
)
;;;Examples:
;;;(vlxls-sheet-add *xlapp* “Sheet1”) return: T
;;;(vlxls-sheet-add *xlapp* NIL) return: T
;;;(vlxls-sheet-add *xlapp* “NewSheet”) return: NIL
(Defun vlxls-sheet-put-active (xlapp Name / sh);;;設置當前使用頁
(if (null (vlxls-sheet-add xlapp name))
(vlax-for sh (vlax-get-property Xlapp "sheets")
(if (= (vlax-get-property sh "Name") Name)
(vlax-invoke-method sh "Activate")
)
)
)
(equal (vlxls-sheet-get-active xlapp) name)
)
;;;Examples:
;;;(vlxls-sheet-put-active *xlapp* “Sheet1”) return: T
;;;(vlxls-sheet-put-active *xlapp* “NewSheet”) return: T
(Defun vlxls-sheet-get-UsedRange (xlapp Name / sh Rtn);;;取得使用頁的使用范圍
(if (null Name)
(setq Name (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'Name))
)
(vlax-for sh (vlax-get-property Xlapp "sheets")
(if (= (vlax-get-property sh "Name") Name)
(setq Rtn (vlax-get-property sh "UsedRange")))
)
Rtn
)
;;;Examples:
;;;(vlxls-sheet-get-usedrange *xlapp* “Sheet1”) return: T
;;;(vlxls-sheet- get-usedrange *xlapp* “NewSheet”) return: T
(Defun vlxls-cellid (id / xx id1 id2 Rtn) ;;;;cell id 轉換
(if (= (type id) 'list)
(setq id (vlxls-rangeid id))
)
(setq id (strcase id))
(if (null (setq xx (vl-string-search ":" id)))
(setq Rtn (list id ""))
(setq id1 (substr id 1 xx)
id2 (substr id (+ xx 2))
id1 (vlxls-rangeid id1)
id2 (vlxls-rangeid id2)
Rtn (list (vlxls-rangeid (list (min (car id1) (car id2))
(min (cadr id1) (cadr id2))))
(vlxls-rangeid (list (max (car id1) (car id2))
(max (cadr id1) (cadr id2)))))
)
)
Rtn
)
;;;Examples:
;;;(vlxls-cellid ‘(3 14)) return: ("C14" "")
;;;(vlxls-cellid “D23”) return: ("D23" "")
;;;(vlxls-cellid “C12:F3”) return: ("C3" "F12")
;;;(vlxls-cellid “F15:G22”) return: ("F15" "G22")
(Defun vlxls-rangeid (id / str->list list->str xid->str Rtn) ;;;;range id 轉換
(Defun str->list1 (str / ii xk xv rr pos x y)
(setq rr (strlen str))
(foreach ii '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
(if (setq pos (vl-string-search ii str))
(setq rr (min pos rr))
)
)
(setq x (substr str 1 rr)
y (substr str (1+ rr))
)
(if (= (strlen x) 2)
(setq xk (- (ascii (substr x 1 1)) 64)
xv (- (ascii (substr x 2)) 64)
)
(setq xk 0
xv (- (ascii x) 64)
)
)
(list (+ (* xk 26) xv) (read y))
)
(Defun xid->str (IntNum / PosNum Nm-One)
(setq Nm-One (1- IntNum)
PosNum (/ Nm-One 26)
)
(if (= PosNum 0)
(chr (+ 65 (rem Nm-One 26)))
(strcat (chr (+ 64 PosNum)) (chr (+ 65 (rem Nm-One 26))))
)
)
(Defun list->str1 (idr / x y)
(setq x (car idr)
y (cadr idr)
x (xid->str x)
y (itoa y)
)
(strcat x y)
)
(cond ((= (type id) 'str) (setq Rtn (str->list1 id)))
((= (type id) 'list) (setq Rtn (list->str1 id)))
)
Rtn
)
;;;Examples:
;;;(vlxls-rangeid ‘(3 14)) return: "C14"
;;;(vlxls-rangeid “D23”) return: (4 23)
;;;(vlxls-rangeid “DD23”) return: (108 23)
(Defun vlxls-range-autofit (range);;自動調整范圍內存儲格
(equal (vlax-variant-value
(msxl-autofit
(msxl-get-columns (msxl-get-Cells range))
)
)
:vlax-true
)
)
;;;Examples:
;;;(vlxls-range-autofit (msxl-get-range *xlapp* “C12:F15”)) return: T
;;;(vlxls-range-autofit RangeObject) return: NIL
(Defun vlxls-cell-put-active (xl id / Rtn);;范圍內激活
(if (= (type id) 'list)
(setq id (vlxls-rangeid id))
)
(msxl-activate (setq Rtn (msxl-get-range xl id)))
Rtn
)
;;;Examples:
;;;(vlxls-cell-put-active *xlapp* “C12:F15”) return: #<VLA-OBJECT Range 09d1998c>
;;;(vlxls-cell-put-active *xlapp* “F12”) return: #<VLA-OBJECT Range 06c389a2>
(Defun vlxls-cell-get-value (xl id);;取得范圍內值并列表
(if (= (type id) 'list)
(setq id (vlxls-rangeid id))
)
(vlxls-variant->list
(msxl-get-value2 (msxl-get-range xl id))
)
)
;;;Examples:
;;;(vlxls-cell-get-value *xlapp* “C12”) return: “g”
;;;(vlxls-cell-get-value *xlapp* “C12:C12”) return: “g”
;;;(vlxls-cell-get-value *xlapp* “C12:C15”) return: (("g") ("") ("") (""))
;;;(vlxls-cell-get-value *xlapp* “C12:F12”) return: (("g" "ds" "" ""))
;;;(vlxls-cell-get-value *xlapp* “C12:F15”) return: (("g" "ds" "" "") ("" "" "g" "") ("" "" "" "") ("" "" "" ""))
(Defun vlxls-cell-put-value (xl id Data / vllist-explode idx xx yy ary Rtn)
;;;;;將信息輸入區域內
(Defun vllist-explode1 (lst)
(cond ((not lst) nil)
((atom lst) (list lst))
((append (vllist-explode1 (car lst))
(vllist-explode1 (cdr lst))
)))
)
(if (null id)
(setq id "A1")
)
(if (= (type id) 'list)
(setq id (vlxls-rangeid id))
)
(if (= (type (car Data)) 'LIST)
(setq ARY (vlax-make-safearray
vlax-vbstring(cons 0 (1- (length Data)))
(cons 1 (length (car Data)))
)
XX (1- (length (car Data)))
YY (1- (length Data))
)
(setq ARY (vlax-make-safearray
vlax-vbstring
(cons 0 1)
(cons 1 (length Data))
)
XX (1- (length Data))
YY 0)
)
(if (= xx yy 0)
(msxl-put-value2
(setq Rtn (msxl-get-range xl id))
(car (vllist-explode1 data))
)
(progn
(setq id (vlxls-cellid-calc id xx yy))
(msxl-put-value2
(setq Rtn (msxl-get-range xl id))
(vlax-safearray-fill ary data)
)
)
)
Rtn
)
;;;Examples:
;;;(vlxls-cell-put-value *xlapp* “C12” “xx”) return: #<VLA-OBJECT Range 093a7764>
;;;(vlxls-cell-put-value *xlapp* “C12:F3” “xx”) return: #<VLA-OBJECT Range 43c5ac64>
;;;(vlxls-cell-put-value *xlapp* “C12:D13” ‘((“zz” “xx”)(“xx” “zz”))) ereturn:
(Defun vlxls-cellid-calc (id x y / idx) ;;;計算范圍
(setq id (car (vlxls-cellid id))
idx (vlxls-rangeid id)
x (+ x (car idx))
x (if (< x 1)
1
x)
y (+ y (cadr idx))
y (if (< y 1)
1
y)
idx (vlxls-rangeid (list x y))
id (vlxls-cellid (strcat id ":" idx))
id (strcat (car id) ":" (cadr id))
)
id
)
;;;Examples:
;;;(vlxls-cellid-calc “C12” 2 20) return: "C12:E32"
;;;(vlxls-cellid-calc ‘(2 23) 2 -120) return: "B1:D23"
(Defun vlxls-get-row-value (xl id len / vllist-explode Rtn);;取出單列的內容
(Defun vllist-explode4 (lst)
(cond ((not lst) nil)
((atom lst) (list lst))
((append (vllist-explode4 (car lst))
(vllist-explode4 (cdr lst))
)
)
)
)
(if (> len 0)
(setq id (vlxls-cellid-calc id (1- len) 0))
(setq id (vlxls-cellid-calc id (1+ len) 0))
)
(setq Rtn (vllist-explode4 (vlxls-cell-get-value xl id)))
Rtn
)
;;;Examples:
;;;(vlxls-get-row-value *xlapp* “C12” 2) return: ("zz" "xxx")
;;;(vlxls-get-row-value *xlapp* “C12” -20) return: ("" "" "zz")
(Defun vlxls-put-row-value (xl id data flg / Rtn);;;單列輸入信息并且flg為t則自動調整尺寸
(if (= (type data) 'str)
(setq data (list data))
)
(setq id (car (vlxls-cellid id))
id (vlxls-cellid-calc id (1- (length data)) 0)
)
(setq Rtn (vlxls-cell-put-value xl id (list data)))
(if flag
(vlxls-range-autofit
rtn
))
Rtn
)
;;;Examples:
;;;(vlxls-put-row-value *xlapp* “C12” “abc”) return:#<VLA-OBJECT Range 2a621cac>
;;;(vlxls-put-row-value *xlapp* ‘(12 3) “abc”) return:#<VLA-OBJECT Range 7a36c491>
;;;(vlxls-put-row-value *xlapp* “C12” ‘("zz" "xxx")) return:#<VLA-OBJECT Range 09d1da1c>
;;;(vlxls-put-row-value *xlapp* ‘(12 3) ‘("zz" "xxx")) return:#<VLA-OBJECT Range 0a26c4f3>
(Defun vlxls-get-column-value (xl id len / vllist-explode Rtn);;取出單欄信息
(Defun vllist-explode3 (lst)
(cond ((not lst) nil)
((atom lst) (list lst))
((append (vllist-explode3 (car lst))
(vllist-explode3 (cdr lst))
)
)
)
)
(setq id (car (vlxls-cellid id)))
(if (> len 0)
(setq id (vlxls-cellid-calc id 0 (1- len)))
(setq id (vlxls-cellid-calc id 0 (1+ len)))
)
(setq Rtn (vllist-explode3 (vlxls-cell-get-value xl id)))
Rtn
)
;;;Examples:
;;;(vlxls-get-column-value *xlapp* “C12” 2) return: ("zz" "sdfsdf")
;;;(vlxls-get-column-value *xlapp* “C12” -20) return: ("" "" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "zz")
(Defun vlxls-put-column-value (xl id data flg / item Rtn);;;單欄輸入信息并且flg為t則自動調整尺寸
(if (= (type data) 'str)
(setq data (list data))
)
(setq id (car (vlxls-cellid id))
id (vlxls-cellid-calc id 0 (1- (length data)))
)
(foreach item data
(setq Rtn (cons (list item) Rtn)))
(setq Rtn (vlxls-cell-put-value xl id (reverse Rtn)))
(if flg
(vlxls-range-autofit
rtn
))
Rtn
)
;;;Examples:
;;;(vlxls-put-column-value *xlapp* “C12” “abc”) return: #<VLA-OBJECT Range 049c521b>
;;;(vlxls-put-column-value *xlapp* ‘(12 3) “abc”) return: #<VLA-OBJECT Range 0235cba1>
;;;(vlxls-put-column-value *xlapp* “C12” ‘("zz" "xxx")) return: #<VLA-OBJECT Range 09d1da1c>
;;;(vlxls-put-column-value *xlapp* ‘(12 3) ‘("zz" "xxx")) return: #<VLA-OBJECT Range 0a26c4f3>
(Defun vlxls-cell-get-aci (xl id)
(vlxls-color-eci->aci
(vlax-variant-value
(msxl-get-colorindex
(msxl-get-interior (msxl-get-range xl id))
)
)
)
)
;;;Examples:
;;;(vlxls-cell-get-aci *xlapp* “C12”) return:256
;;;(vlxls-cell-get-aci *xlapp* ‘(12 3)) return:15
(Defun vlxls-cell-put-aci (xl id aci / Rtn)
(if (null aci)
(msxl-put-colorindex
(msxl-get-interior (setq Rtn (msxl-get-range xl id)))
(vlax-make-variant -4142)
)
(msxl-put-colorindex
(msxl-get-interior (setq Rtn (msxl-get-range xl id)))
(vlxls-color-aci->eci aci)
)
)
Rtn
)
;;;Examples:
;;;(vlxls-cell-put-aci *xlapp* “C12” 6) return: #<VLA-OBJECT Range 09d1369c>
;;;(vlxls-cell-put-aci *xlapp* “C12” nil) return: #<VLA-OBJECT Range 09d1369c>
(Defun vlxls-text-get-aci (xl id)
(vlxls-color-eci->aci
(vlax-variant-value
(msxl-get-colorindex
(msxl-get-font (msxl-get-range xl id))
)
)
)
Rtn
)
;;;Examples:
;;;(vlxls-text-get-aci *xlapp* “C12”) return: 256
;;;(vlxls-text-get-aci *xlapp* ‘(12 3)) return: 15
(Defun vlxls-text-put-aci (xl id aci / Rtn)
(if (null aci)
(msxl-put-colorindex
(msxl-get-font (setq Rtn (msxl-get-range xl id)))
(vlax-make-variant -4105)
)
(msxl-put-colorindex
(msxl-get-font (setq Rtn (msxl-get-range xl id)))
(vlxls-color-aci->eci aci)
)
)
Rtn
)
;;;Examples:
;;;(vlxls-text-put-aci *xlapp* “C12” 6) return: #<VLA-OBJECT Range 09d1369c>
;;;(vlxls-text-put-aci *xlapp* “C12” nil) return: #<VLA-OBJECT Range 09d1369c>
(Defun vlxls-text-get-prop(xl id / Cell Font DXF1 DXF7 DXF40 DXF72 DXF62 DXF420 Rtn)
;;;;取得單元格文字相關信息
(setq id (car (vlxls-cellid id))
cell (msxl-get-range xl id)
font (msxl-get-font cell)
DXF7 (vlax-variant-value (msxl-get-name Font))
DXF40 (vlax-variant-value (msxl-get-size Font))
DXF72 (vlax-variant-value (msxl-get-HorizontalAlignment Cell)
)
DXF72 (cond ((= DXF72 -4152) 11)
((= DXF72 -4108) 10)
(t 9)
)
DXF62 (vlxls-color-eci->aci
(vlax-variant-value (msxl-get-colorIndex Font))
)
DXF420 (vlxls-color-eci->truecolor
(vlax-variant-value (msxl-get-colorIndex Font)))
Rtn (list (cons 0 (strcase id))
(cons 7 DXF7)(cons 40 DXF40)(cons 62 DXF62)
(cons 72 DXF72)(cons 420 DXF420)))
Rtn
)
;;;Examples:
;;;(vlxls-text-get-prop *xlapp* “C12”) return:((0 . "C12") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 9) (420 . 16711935))
;;;(vlxls-text-get-prop *xlapp* ‘(2 10)) return:((0 . "B10") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 11) (420 . 16711935))
(Defun vlxls-cell-get-prop(xl id / range left top width height dxf10 Rtn)
;;;;取得單元格信息
(if (vlxls-cell-merge-p xl id)
(setq id (vlxls-cell-get-mergeid xl id))
)
(setq range (msxl-get-range xl id)
left (vlax-variant-value (msxl-get-left Range))
top (vlax-variant-value (msxl-get-top Range))
width (vlax-variant-value (msxl-get-width Range))
height (vlax-variant-value (msxl-get-height Range))
dxf10 (list left top)
Rtn (list (cons 0 (strcase id))
(cons 1 (vlxls-cell-get-value xl id))
(cons 10 dxf10)
(cons 41 width)
(cons 42 height)
(cons -1 (vlxls-text-get-prop xl id))
)
)
Rtn
)
;;;Examples:
;;;(vlxls-cell-get-prop *xlapp* “C12:F14”) return:((0 . "C12:F14") (1 ("zz" "xxx" "xxx" "xxx") ("sdfsdf" "sdfsdf" "sdfsdf" "sdfsdf")
;;; ("sdfsdf" "sdfsdf" "sdfsdf" "sdfsdf")) (10 108.0 156.75) (41 . 156.0) (42 . 42.75) (-1 (0 . "C12") (7 . "Arial")
;;; (40 . 12.0) (62 . 256) (72 . 9) (420 . 16711935)))
;;;(vlxls-cell-get-prop *xlapp* “B8”) return: ((0 . "B8") (1 . "sdg") (10 54.0 99.75) (41 . 54.0) (42 . 14.25) (-1 (0 . "B8")
;;; (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 10) (420 . 16711935)))
(Defun vlxls-cell-border (xl id flg / bdr);;;外框線
(if flg
(msxl-put-value
(msxl-get-borders
(msxl-get-range xl id)
)
1
)
(msxl-put-value
(msxl-get-borders
(msxl-get-range xl id)
)
'linestyle
msxl-xlnone
)
)
)
;;;Examples:
;;;(vlxls-cell-border *xlapp* “C12:F14” T) return:NIL
;;;(vlxls-cell-border *xlapp* “B8” NIL) return:NIL
(Defun vlxls-cell-merge (xl id / vllist-explode Val Rtn)
;;;;;;;;;合并單元格
(Defun vllist-explode2 (lst)
(cond ((not lst) nil)
((atom lst) (list lst))
((append (vllist-explode2 (car lst))
(vllist-explode2 (cdr lst))
)
)
)
)
(setq val (vllist-explode2 (vlxls-cell-get-value xl id)))
(while (vl-position "" val)
(setq val (vl-remove "" val))
)
(setq val (car val)
Rtn (msxl-get-range xl id)
)
(msxl-clear Rtn)
(msxl-merge Rtn nil)
(msxl-put-value2 Rtn Val)
(msxl-put-HorizontalAlignment Rtn -4108)
Rtn
)
;;;Examples:
;;;(vlxls-cell-merge *xlapp* “C12:F14”) return: #<VLA-OBJECT Range 0023ab7c>
(Defun vlxls-cell-unmerge (xl id / Rtn);;;取消合并單元格
(if (vlxls-cell-merge-p xl id)
(progn
(vlax-invoke-method (msxl-get-range xl id) 'unmerge)
(setq Rtn (msxl-get-range xl id))
)
)
Rtn
)
;;;Examples:
;;;(vlxls-cell-unmerge *xlapp* “C12:F14”) return:#<VLA-OBJECT Range 0023ab7c>
;;;(vlxls-cell-unmerge *xlapp* “E14”) return:#<VLA-OBJECT Range 09ce72e4>
(Defun vlxls-cell-merge-p (xl id);;;判斷單元格是否合并
(equal (vlax-variant-value
(msxl-get-mergecells (msxl-get-range xl id))
)
:vlax-true
)
)
;;;Examples:
;;;(vlxls-cell-merge-p *xlapp* “C12:F14”) return:T
;;;(vlxls-cell-merge-p *xlapp* “E14”) return:NIL
(Defun vlxls-cell-get-mergeid (XL ID / Rtn);;;取得單元格合并的范圍
(if (vlxls-cell-merge-p xl id)
(progn
(msxl-select (msxl-get-range xl id))
(setq Rtn (vlxls-range-getid (msxl-get-selection xl)))
)
)
Rtn
)
;;;Examples:
;;;(vlxls-cell-get-mergeid *xlapp* “C12:F14”) return: "B9:G19”
;;;(vlxls-cell-get-mergeid *xlapp* “E14”) return: "A11:G19
(Defun vlxls-range-getID (range / col row dx dy);;;取得單元格地址
(setq dx (vlxls-get-property range "MergeArea.Rows.Count")
dy (vlxls-get-property range "MergeArea.Columns.Count")
row (vlxls-get-property range "MergeArea.Row")
col (vlxls-get-property range "MergeArea.Column")
)
(strcat (vlxls-rangeid (list col row))
":"
(vlxls-rangeid (list (1- (+ col dy)) (1- (+ row dx)))))
)
;;;Examples:
;;;(vlxls-range-getid RangeObject) return: ”C12:G19”
;;;(vlxls-range-getid RangeObject) return: ”B16:B16”
(Defun vlxls-range-size (range / xl row col rrr ccc xxx yyy);;;;取得單元范圍尺寸
(setq xl (msxl-get-parent range)
Row (msxl-get-count (msxl-get-rows Range))
Col (msxl-get-count (msxl-get-columns Range))
RRR (1- (msxl-get-row Range))
CCC (msxl-get-column Range)
)
(repeat Row
(setq yyy (cons (vlax-variant-value
(msxl-get-height
(msxl-get-range
xl
(vlxls-rangeid (list CCC (setq RRR (1+ RRR))))
)
)
)
yyy
)
)
)
(setq RRR (msxl-get-row Range)
CCC (1- (msxl-get-column Range))
)
(repeat Col
(setq xxx (cons (vlax-variant-value
(msxl-get-width
(msxl-get-range
xl
(vlxls-rangeid (list (setq CCC (1+ CCC)) RRR))
)
)
)
xxx
)
)
)
(list (reverse xxx) (reverse yyy))
)
;;;Examples:
;;;(vlxls-range-size RangeObject) return: ((27.0 27.0 110.25 51.0 69.75) (14.25 14.25 14.25 14.25 14.25 57.0 14.25))
(Defun vlxls-Rangevalue->SafeArray (Data / XSub_GetXY XSub_GetMinMaxID xsub-MergeID->List
MinID MaxID ID ID1 ID2 IDN X minid xy Y Rtn Item)
;;;;;;;;;;;;;安全數組
(Defun xsub-MergeID->List1 (ID / KK ID1 ID2 IDX IDY Rtn)
(Setq ID (strcase ID))
(if (setq KK (vl-string-search ":" ID))
(setq ID1 (substr ID 1 KK)
ID2 (substr ID (+ 2 KK))
)
(setq ID1 ID
ID2 ID)
)
(setq ID1 (vlxls-rangeid ID1)
ID2 (vlxls-rangeid ID2)
IDX (vlxls-rangeid
(list (min (nth 0 ID1) (nth 0 ID2))
(min (nth 1 ID1) (nth 1 ID2))
)
)
IDY
(vlxls-rangeid
(list (max (nth 0 ID1) (nth 0 ID2))
(max (nth 1 ID1) (nth 1 ID2))
)
)
Rtn (list IDX IDY)
)
Rtn
)
(Defun XSub_GetXY1 (ID SID / S10 S11 DX DY Rtn)
(setq S10 (nth 0 MinID)
S11 (nth 1 MinID)
ID (vlxls-rangeid ID)
DX (- (nth 0 ID) S10)
DY (- (nth 1 ID) S11)
Rtn (list DX DY)
)
Rtn
)
(Defun XSub_GetMinMaxID1 (ID1 ID MinorMax / X Y X1 Y1 Rtn)
(if (null ID)
(setq Rtn ID1)
(progn
(setq ID1 (vlxls-rangeid ID1)
ID (vlxls-rangeid ID)
X1 (nth 0 ID1)
Y1 (nth 1 ID1)
X (nth 0 ID)
Y (nth 1 ID)
)
(if (null MinorMax)
(setq Rtn (vlxls-rangeid (list (min X X1) (min Y Y1))))
(setq Rtn (vlxls-rangeid (list (max X X1) (max Y Y1))))
)
)
)
Rtn
)
(foreach Item Data
(setq ID (strcase (car Item)))
(if (vl-string-search ":" ID)
(setq IDN (xsub-MergeID->List1 ID))
(setq IDN (list ID))
)
(foreach ID IDN
(setq MinID (XSub_GetMinMaxID1 ID MinID nil)
MaxID (XSub_GetMinMaxID1 ID MaxID T)
)
)
)
(setq MinID (vlxls-rangeid MinID)
MaxID (vlxls-rangeid MaxID)
X (- (nth 0 MaxID) (nth 0 MinID))
Y (- (nth 1 MaxID) (nth 1 MinID))
Rtn (vlax-make-safearray
vlax-vbstring
(cons 0 Y)
(cons 1 (1+ X))
)
)
(foreach Item Data
(setq ID (strcase (car Item)))
(if (vl-string-search ":" ID)
(setq IDN (xsub-MergeID->List1 ID))
(setq IDN (list ID))
)
(foreach ID IDN
(setq XY (XSub_GetXY1 ID MinID))
(vlax-safearray-put-element
Rtn
(nth 1 XY)
(1+ (nth 0 XY))
(cdr Item)
)
)
)
Rtn
)
;;;Examples:
;;;(vlxls-rangevalue->safearray ‘((“A1” . “aaa”)(“B4” . “ccc”))) return: #<safearray...>
;;;(vlxls-variant->list (vlxls-rangevalue->safearray '(("A1" . "aaa")("B4" . "ccc")))) return: (("aaa" "") ("" "") ("" "") ("" "ccc"))
(Defun vlxls-get-property (top prop / item Rtn);vlstring->list
;;;;取得多重屬性
(Defun vlstring->list (str st / lst e)
(setq str (strcat str st))
(while (vl-string-search st str)
(setq
lst
(append lst (list (substr str 1 (vl-string-search st str))))
)
(setq
str
(substr str (+ (1+ (strlen st)) (vl-string-search st str)))
)
)
(if lst
(mapcar '(lambda (e) (vl-string-trim " " e)) lst)
)
)
(cond ((= (type prop) 'sym)
(setq Rtn (vlax-get-property top prop))
)
((= (type prop) 'str)
(if (null (vl-string-search "." prop))
(setq Rtn (vlax-get-property top prop))
(foreach item (vlstring->list prop ".")
(if (null Rtn)
(setq Rtn (vlax-get-property top item))
(setq Rtn (vlax-get-property Rtn item))
))))
)
(cond ((= (type Rtn) 'variant)
(setq Rtn (vlax-variant-value Rtn))
)
((= (type Rtn) 'safearray)
(setq Rtn (vlxls-variant->list Rtn))
)
)
Rtn
)
;;;Examples:
;;;(vlxls-get-property RangeObject “Application.ActiveSheet.Name”) return: ”Sheet1”
;;;(vlxls-get-property RangeObject “MergeArea.Columns.Count”) return: 3
(setq *xls-color*
(list (list 1 18 0)
(list 2 7 1677215)
(list 3 1 16711680)
(list 4 3 65280)
(list 5 5 255)
(list 6 2 16776960)
(list 7 6 16711935)
(list 8 4 65535)
(list 9 16 8323072)
(list 10 96 32512)
(list 11 176 127)
(list 12 56 8355584)
(list 13 216 8323199)
(list 14 136 32639)
(list 15 9 12566463)
(list 16 8 8355711)
(list 17 161 9476095)
(list 18 237 9449568)
(list 19 7 1677167)
(list 20 254 12648447)
(list 21 218 6291552)
(list 22 11 16744319)
(list 23 152 24768)
(list 24 254 13617407)
(list 25 176 127)
(list 26 6 16711935)
(list 27 2 16776960)
(list 28 4 65535)
(list 29 216 8323199)
(list 30 16 8323072)
(list 31 136 32639)
(list 32 5 255)
(list 33 140 51455)
(list 34 254 12648447)
(list 35 254 13631439)
(list 36 51 16777104)
(list 37 151 9488639)
(list 38 221 16750799)
(list 39 191 13605119)
(list 40 31 16763024)
(list 41 150 3105023)
(list 42 132 3131584)
(list 43 62 9488384)
(list 44 40 16762880)
(list 45 30 16750336)
(list 46 30 16738048)
(list 47 165 6317968)
(list 48 252 9475984)
(list 49 148 12384)
(list 50 105 3184736)
(list 51 98 12032)
(list 52 48 3158016)
(list 53 24 9449472)
(list 54 237 9449311)
(list 55 177 3158160)
(list 56 250 3092527)
)
*Chinese* t
)
(if vl-load-com
(vl-load-com))
(if vl-arx-import
(foreach item '(ACAD_COLORDLG ACAD_truecolordlg
ACAD_STRLSORT INITDIA
ACAD-POP-DBMOD ACAD-PUSH-DBMOD
STARTAPP layoutlist
)
(vl-arx-import item)
)
)
(setq item nil
*xls-ver* "1.1.40715"
)
(princ
(strcat "\n VLAE:VLXLS Freebie API Version " *xls-ver*)
)
(princ
"\n Copyright(C) 1994-2005 KozMos Inc. All rights reserved"
)
(princ)
(defun vlxls-ScreenUpdating-Off (*xlapp*)
(vlax-put-property *xlapp* 'ScreenUpdating 0))
(defun vlxls-ScreenUpdating-On (*xlapp*)
(vlax-put-property *xlapp* 'ScreenUpdating -1))
;;*************************************************************************
;;; 模塊： vlxls-Excel-ColumnWidth
;;; 描述：調整寬度col為width
;;; 參數： sheet (object)
;;; 示例： (vlxls-Excel-ColumnWidth xlapp 2 12);;調整B欄寬為12
;;;*************************************************************************
(defun vlxls-ColumnWidth(xlapp col width / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(vlax-put-property (setq cell (vlxls-get-cell sheet 1 col)) "ColumnWidth"
width)
)
;;;*************************************************************************
;;; 模塊： mSX-Excel-RowHeight
;;; 描述：調整列高row為height
;;; 參數： sheet (object)
;;; 示例： (mSX-Excel-ColumnWidth xlapp 3 15);;調整3列高為15
;;;*************************************************************************
(defun vlxls-RowHeight(xlapp row height / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(vlax-put-property (setq cell (vlxls-get-cell sheet row 1)) "RowHeight"
height)
)
(defun vlxls-get-cell (obj row col / item cells)
(setq item (vlax-get-property
(setq cells (vlax-get-property obj "Cells"))
"Item"
(vlax-make-variant row)
(vlax-make-variant col)))
(vlax-release-object cells)
(vlax-variant-value item))
(defun vlxls-put-pagesetup(xlapp top bot lef rig hea fot flh flv);;設置版面
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq page (vlax-get-property sheet "pagesetup"))
(vlax-put-property page "footermargin" (* fot 28.3465))
(vlax-put-property page "headermargin" (* hea 28.3465))
(vlax-put-property page "leftmargin" (* lef 28.3465))
(vlax-put-property page "rightmargin" (* 28.3465 rig))
(vlax-put-property page "topmargin" (* top 28.3465))
(vlax-put-property page "bottommargin" (* bot 28.3465))
(vlax-put-property page "CenterHorizontally" (* 28.3465 flh))
(vlax-put-property page "CenterVertically" (* flv 28.3465))
)
;;;*************************************************************************
;;; 模塊： vlxls-Excel-cellfontname
;;; 描述：更改單元格字體
;;; 參數： row col name
;;; 示例： (vlxls-Excel-cellfontname 2 3 "新細明體");;更改單元格C2字體為"新細明體"
;;;*************************************************************************
(defun vlxls-Excel-cellfontname(xlapp row col name / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(vlax-put-property(vlax-get-property (setq cell (msx-get-cell sheet row col)) "font"
) "name" name
))
;;;*************************************************************************
;;; 模塊： vlxls-Excel-cellcolor
;;; 描述：更改單元格顏色
;;; 參數： row col color
;;; 示例： (vlxls-Excel-cellcolor2 3 14);;更改單元格C2為14號色
;;;*************************************************************************
(defun vlxls-Excel-cellcolor(xlapp row col color / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq cell (vlxls-get-cell sheet row col))
(msxl-put-ColorIndex (msxl-get-Interior cell) color))
;;;*************************************************************************
;;; 模塊： vlxls-Excel-textcolor
;;; 描述：更改單元格文字顏色
;;; 參數： row col color
;;; 示例： (vlxls-Excel-textcolor 2 3 14);;更改單元格C2文字為14號色
;;;*************************************************************************
(defun vlxls-Excel-textcolor(xlapp row col color / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq cell (vlxls-get-cell sheet row col))
(vlax-put-property (vlax-get-property cell "font") "ColorIndex" color))
;;;*************************************************************************
;;; 模塊： vlxls-Excel-textsize
;;; 描述：更改單元格文字大小
;;; 參數： row col size
;;; 示例： (vlxls-Excel-textsize 2 3 18);;更改單元格C2文字為18號字大小
;;;*************************************************************************
(defun vlxls-Excel-textsize(xlapp row col size / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq cell (vlxls-get-cell sheet row col))
(vlax-put-property (vlax-get-property cell "font") "Size" size))
;;;*************************************************************************
;;; 模塊： vlxls-Excel-textunderline
;;; 描述：更改單元格文字下畫線
;;; 參數： row col size
;;; 示例： (vlxls-Excel-textunderline 2 3 1);;更改單元格C2文字無下划線
;;;*************************************************************************
(defun vlxls-Excel-textunderline(xlapp row col underline / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq cell (vlxls-get-cell sheet row col))
(vlax-put-property (vlax-get-property cell "font") "Underline" underline))
;;;;;注: underline 1---------無下划線
;;;;; 2---------單線
;;;;; 3---------雙線
;;;;; 4---------會計用單線
;;;;; 5---------會計用雙線
;;;*************************************************************************
;;; 模塊： vlxls-Excel-fontstyle
;;; 描述：更改單元格文字形式
;;; 參數： row col color
;;; 示例： (vlxls-Excel-fontstyle 2 3 "粗體");;更改單元格C2文字為14粗體
;;;*************************************************************************
(defun vlxls-Excel-fontstyle(xlapp row col style / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq cell (vlxls-get-cell sheet row col))
(vlax-put-property (vlax-get-property cell "font") "FontStyle" style))
;;;*************************************************************************
;;; 模塊： vlxls-Excel-fontspecial
;;; 描述：更改單元格文字特殊效果
;;; 參數： row col color
;;; 示例： (vlxls-Excel-fontspecial 2 3 "Strikethrough" item);;更改單元格C2文字特殊效果為刪線
;;; "Superscript"為上標 "Subscript" 為下標 (item設置為0則停用,-1為啟用)
;;;*************************************************************************
(defun vlxls-Excel-fontspecial(xlapp row col special item / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq cell (vlxls-get-cell sheet row col))
(vlax-put-property (vlax-get-property cell "font") special item))
;;;*************************************************************************
;;; 模塊： vlxls-Excel-textAlignment
;;; 描述：更改單元格文字對齊方式
;;; 參數： row col color hal val
;;; 示例： (vlxls-Excel-textAlignment 2 3 1 -4108);;更改單元格C2文字對齊方式水平方向一般﹐垂直置中
;;;*************************************************************************
(defun vlxls-Excel-textAlignment(xlapp row col hal val / sheet cell)
(setq sheet (vlax-get-property xlapp "ActiveSheet"))
(setq cell (vlxls-get-cell sheet row col))
(vlax-put-property cell "HorizontalAlignment" hal)
(vlax-put-property cell "VerticalAlignment" val))
;;;注:水平方式 1 ----------一般
;;;;;;;;; -4131----------左縮排 ;;;;或2
;;;;;;;;; -4108----------置中對齊 ;;或3
;;;;;;;;; -4152----------靠右對齊 ;;或4
;;;;;;;;; 5 ----------填滿 ;;或5
;;;;;;;;; -4130----------水平對齊 ;;或6
;;;;;;;;; 7----------跨欄置中
;;;;;;;;; -4117----------分散對齊 ;;或8
;;;注:垂直方式 -4160 ----------靠上或1
;;;;;;;;; -4108----------置中對齊或2
;;;;;;;;; -4107----------靠下或3
;;;;;;;;; -4130----------垂直對齊或4
;;;;;;;;; -4117 ----------分散對齊或5

;;;;;;;;此為經整理過后一些VLISP調用EXCEL常用公共函數;;;;;;;;;;;; 
;;;;;;;;此為私人函數未經許可請勿............................... 
;;;;;;;;開發:朱衛星 2005/02/22 rev01............................ 
;;;;;;;;it's the first!ok!used in acad at least rev. 2000;;;;;;; 
(Defun vlxls-variant->list (VarX / Run Item Rtn) 
  (setq Run T) 
  (while Run 
    (cond ((= (type VarX) 'SAFEARRAY) 
    (setq VarX (vlax-safearray->list VarX))) 
    ((= (type VarX) 'VARIANT) 
     (if    (member (vlax-variant-type VarX) (list 5 4 3 2)) 
     (setq VarX (vlax-variant-change-type Varx vlax-vbString))) 
     (setq VarX (vlax-variant-value VarX))) 
          (t (setq Run nil))) 
    ) 
   (cond  ((= (type VarX) 'LIST) 
           (foreach Item VarX 
             (setq Item (vlxls-variant->list Item) Rtn  (append Rtn (list Item)) 
                   ) 
             ) 
           ) 
      ((= VarX nil) (setq Rtn "")) 
      (t (setq Rtn VarX))) 
  Rtn) 
 
 
(Defun vlxls-color-ECI->truecolor (Color / Rtn) 
  (if (setq Rtn (cdr (assoc Color *xls-color*))) 
  (setq Rtn (nth 1 Rtn))) 
  (if (null Rtn) 
  (setq Rtn 16711935) 
  )Rtn 
  ) 
;;;EXAMPLE: 
;;;(vlxls-color-eci->truecolor 0)return: 16711935 
;;;(vlxls-color-eci->truecolor 1)return: 0 
;;;(vlxls-color-eci->truecolor 12)return: 8355584 
;;;(vlxls-color-eci->truecolor 120)return: 16711935 
 
 
(Defun vlxls-color-eci->aci (Color / Rtn) 
 (if (null (setq Rtn (cdr (assoc Color *xls-color*)))) 
 (setq Rtn 256) 
 (setq Rtn (nth 0 Rtn)) 
 ) 
 Rtn) 
;;;EXAMPLE: 
;;;(vlxls-color-eci->aci 0)return: 256 
;;;(vlxls-color-eci->aci 1)return: 18 
;;;(vlxls-color-eci->aci 12)return: 56 
;;;(vlxls-color-eci->aci 120)return: 256 
 
 
(Defun vlxls-color-aci->eci (Color / Item Rtn) 
  (foreach Item    *xls-color* 
    (if    (= (nth 1 Item) Color) 
    (setq Rtn (car Item))) 
   ) 
  (if (null Rtn) 
  (setq Rtn 0)) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-color-aci->eci 0)return: 0 
;;;(vlxls-color-aci->eci 1)return: 3 
;;;(vlxls-color-aci->eci 12)return: 0 
;;;(vlxls-color-aci->eci 120)return: 0 
 
(Defun vlxls-color-aci->truecolor (aci) 
 (vlxls-color-eci->truecolor (vlxls-color-aci->eci aci)) 
  ) 
;;;Examples: 
;;;(vlxls-color-aci-> truecolor 0) return: 16711935 
;;;(vlxls-color-aci->truecolor 1)  return: 16711680 
;;;(vlxls-color-aci-> truecolor 12)return: 16711935 
;;;(vlxls-color-aci-> truecolor 120)return: 16711935 
 
;;;OK!NOW LET'S GO! START EXCEL.APPLICATION!!............ 
;;;before use these program you should install "Microsoft Excel" in your computer!! 
;;;if not,you will recicieve an error messege!! 
;;;such as "warning:........."! ZWX 2005/02/22 COPYRIGHT ..... 
(Defun vlxls-app-Init (/ OSVar GGG Olb8 Olb9 Olb10 TLB Out msg msg1 msg2) 
  ;;;;;;;;;;該程序實現了初始化EXCEL應用程序! 
  (if *Chinese* 
  (setq msg  "\n 初始化微軟Excel " 
        msg1 "\042初始化Excel失敗\042" 
        msg2 (strcat "\042 警告""\n ====""\n 無法在您的計算机上檢測到微軟Excel軟件" 
              "\n 如果您确認已經安裝Excel, 請發送電子郵" 
              "\n 件到yota@ikozmos.com獲取更多的解決方案\042")) 
  (setq msg  "\n Initializing Microsoft Excel " 
        msg1 "\042Initialization Error\042" 
        msg2 (strcat "\042 WARNING""\n =======" 
                     "\n Can NOT detect Excel97/200X/XP in your computer" 
                     "\n If you already have Excel installed, please email" 
                     "\n us to get more solution via [email]yota@ikozmos.com[/email]\042")) 
    ) 
(if (null msxl-xl24HourClock) 
(progn (if (and (setq GGG (vl-registry-read 
        "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\Excel.EXE" 
        "Path")) 
(setq GGG (strcase (strcat GGG "Excel.EXE")))) 
(progn (foreach OSVar (list "SYSTEMROOT" "WINDIR""WINBOOTDIR" "SYSTEMDRIVE" 
           "USERNAME"  "COMPUTERNAME" "HOMEDRIVE" "HOMEPATH" "PROGRAMFILES") 
   (if    (vl-string-search (strcat "%" OSVar "%") GGG) 
          (setq GGG (vl-string-subst (strcase (getenv OSVar)) 
                      (strcat "%" OSVar "%")GGG))) 
         ) 
 (setq   Olb8  (findfile (vl-string-subst "EXCEL8.OLB" "EXCEL.EXE" GGG)) 
         Olb9  (findfile (vl-string-subst "EXCEL9.OLB" "EXCEL.EXE" GGG)) 
         Olb10 (findfile (vl-string-subst "EXCEL10.OLB" "EXCEL.EXE" GGG))) 
 (cond  ((= (vl-filename-base (vl-filename-directory GGG))"OFFICE11") 
         (setq TLB GGG Out "2003")) 
        ((= (vl-filename-base (vl-filename-directory GGG)) 
            "OFFICE10") 
         (setq TLB GGG Out "XP")) 
         (Olb9 (setq TLB Olb9 Out "2000")) 
         (Olb8 (setq TLB Olb8 Out "97")) 
         (t (setq Out "Version Unknown")) 
        ) 
  (if TLB (progn (princ (strcat MSG Out "...")) 
                 (vlax-import-type-library 
                    :tlb-filename TLB 
                    :methods-prefix "msxl-" 
                    :properties-prefix "msxl-" 
                    :constants-prefix "msxl-")) 
    ) 
  )(progn (if vldcl-msgbox 
             (vldcl-msgbox "x" msg1 msg2) 
             (alert (read msg2))) 
          (exit))) 
  ) 
  ) 
  msxl-xl24HourClock 
  ) 
;;;Examples: 
;;;(vlxls-app-init) return: 33 
 
(Defun vlxls-app-New (UnHide / Rtn) 
  ;;;; 該程序實現功能:新建一個excel格 
  ;;;;;;;;;; THIS PROGRAM CAN BUILD A NEW EXCELFILE 
  (if (vlxls-app-init) 
      (progn 
      (if *Chinese* (princ "\n 新建微軟Excel工作表...") 
                    (princ "\n Creating new Excel Spreadsheet file...")) 
      (if (setq Rtn (vlax-get-or-create-object "Excel.Application")) 
      (progn (vlax-invoke-method 
             (vlax-get-property Rtn 'WorkBooks) 
             'Add) 
        (if UnHide (vla-put-visible Rtn 1) 
          (vla-put-visible Rtn 0)) 
    ) 
    ) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(setq *xlapp* (vlxls-app-new T)) return: #<VLA-OBJECT _Application 001db27c> 
 
(Defun vlxls-app-open(XLSFile UnHide / ExcelApp WorkSheet Sheets ActiveSheet Rtn) 
  ;;;function: this program can open an excelfile 
  (setq XLSFile (strcase XLSFile)) 
  (if (null (wcmatch XLSFile "*.XLS")) 
  (setq XLSFile (strcat XLSFile ".XLS"))) 
  (if (and (findfile XLSFile) 
       (setq Rtn (vlax-get-or-create-object "Excel.Application"))) 
    (progn (vlax-invoke-method (vlax-get-property Rtn 'WorkBooks) 
        'Open XLSFile) 
 (if UnHide 
    (vla-put-visible Rtn 1) 
    (vla-put-visible Rtn 0)))) 
  Rtn) 
 
;;;Examples: 
;;;(setq *xlapp* (vlxls-app-open “C:/test.XLS” T)) e #<VLA-OBJECT _Application 001efd2c> 
 
(Defun vlxls-app-save (xlapp) 
  ;;;;保存文件 
  (equal (vlax-invoke-method 
         (vlax-get-property Xlapp "ActiveWorkbook")"Save") 
         :vlax-true) 
  ) 
;;;Examples: 
;;;(vlxls-app-save *xlapp*) return: T 
 
(Defun vlxls-app-saveas (xlapp Filename / Rtn);;;另存文件 
   (if (null filename) 
    (setq filename (strcat (getvar "dwgprefix") "XLS.XLS"))) 
   (if (null (wcmatch (setq filename (strcase Filename)) "*.XLS")) 
   (setq filename (strcat filename ".XLS"))) 
   (if (findfile Filename) 
    (vl-file-delete (findfile Filename)) 
    ) 
   (vlax-invoke-method 
     (vlax-get-property Xlapp "ActiveWorkbook") 
     "SaveAs" 
     Filename 
     msxl-xlNormal 
     "" 
     "" 
     :vlax-False 
     :vlax-False 
     nil 
     ) 
  (findfile Filename) 
  ) 
 
;;;Examples: 
;;;(vlxls-app-saveas *xlapp* nil) return: “C:/Temp-Folder/XLS.XLS” 
;;;(vlxls-app-saveas *xlapp* “C:/Temp-Folder/XLS.XLS”) return: “C:/Temp-Folder/XLS.XLS” 
;;;(vlxls-app-saveas *xlapp* nil) return: NIL 
 
(Defun vlxls-app-quit (ExlObj SaveYN);;退出應用程序 
  (if SaveYN 
     (vlax-invoke-method 
       (vlax-get-property ExlObj "ActiveWorkbook") 
       'Close 
       ) 
    (vlax-invoke-method 
      (vlax-get-property ExlObj "ActiveWorkbook") 
      'Close 
        :vlax-False 
      ) 
    ) 
  (vlax-invoke-method ExlObj 'QUIT) 
  (vlax-release-object ExlObj) 
  (setq ExlObj nil) 
  (gc) 
  ) 
;;;Examples: 
;;;(vlxls-app-quit *xlapp* nil) return: nil 
 
(Defun vlxls-app-kill (SaveYN / ExlObj);;;強行清除所有EXCEL應用程序 
  (while (setq ExlObj (vlax-get-object "Excel.Application")) 
    (vlxls-app-quit ExlObj SaveYN)) 
  ) 
;;;Examples: 
;;;(vlxls-app-kill T) return: nil 
 
(Defun vlxls-app-autofit (xlapp / sh act Rtn);;;存儲格自動調整大小 
  (setq act (vlxls-Sheet-Get-Active xlapp)) 
  (foreach sh (append (vl-remove act (vlxls-sheet-get-all Xlapp)) 
            (list act)) 
  (setq Rtn (variant-value (msxl-autofit 
                             (msxl-get-columns 
                               (msxl-get-Cells 
              (vlxls-sheet-get-usedrange xlapp sh)))))) 
    ) 
  (equal Rtn :vlax-true) 
  ) 
;;;Examples: 
;;;(vlxls-app-autofit *xlapp*) return: T 
;;;(vlxls-app-autofit *xlapp*) return: NIL 
 
(Defun vlxls-sheet-get-all (xlapp / SH Rtn);;;;取得所有應用的頁 
  (vlax-for SH (vlax-get-property Xlapp "sheets") 
  (setq Rtn (cons (vlax-get-property sh "Name") Rtn)) 
  )(reverse Rtn) 
  ) 
;;;Examples: 
;;;(vlxls-sheet-get-all *xlapp*) e ("Sheet1" "Sheet2" "Sheet3") 
 
(Defun vlxls-Sheet-Get-Active (xlapp);;;;返回當前應用的頁 
  (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'name) 
  ) 
;;;Examples: 
;;;(vlxls-sheet-get-active *xlapp*) return: "Sheet2" 
 
(Defun vlxls-sheet-delete (xlapp Name / sh Rtn);;;刪除頁 
  (setq Rtn (vlxls-sheet-get-all Xlapp)) 
  (vlax-for sh (vlax-get-property Xlapp "sheets") 
   (if    (= (vlax-get-property sh "Name") Name) 
    (vlax-invoke-method sh "Delete")) 
    ) 
  (not (equal Rtn (vlxls-sheet-get-all Xlapp))) 
  ) 
;;;Examples: 
;;;(vlxls-sheet-delete *xlapp* “Sheet1”) return: T 
;;;(vlxls-sheet-delete *xlapp* “UnExistingSheet”) return: NIL 
 
(Defun vlxls-sheet-rename (New Old Xlapp / sh Rtn);;;給頁重新命名 
  (if (null old) 
    (setq old (msxl-get-name (msxl-get-activesheet Xlapp)))) 
  (if (member New (vlxls-sheet-get-all Xlapp)) 
   (setq Rtn nil) 
    (progn (vlax-for sh (vlax-get-property Xlapp "sheets") 
          (if (= (msxl-get-name sh) Old) 
           (msxl-put-name sh New))) 
      (setq Rtn (equal New (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'name))) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-sheet-rename “New” “Sheet1” *xlapp*) return: T 
;;;(vlxls-sheet-rename “New” NIL *xlapp*) return: T 
;;;(vlxls-sheet-rename “Sheet3” NIL *xlapp*) return: NIL 
;;;(vlxls-sheet-rename “Sheet2” “Sheet1” *xlapp*) return: NIL 
;;;(vlxls-sheet-rename “Sheet2” “UnExistSheet” *xlapp*) return: NIL 
 
(Defun vlxls-sheet-add (xlapp Name / Rtn);;;增加頁 
  (if (member name (vlxls-sheet-get-all xlapp)) 
      (setq Rtn nil) 
   (progn (vlax-put-property 
          (vlax-invoke-method 
            (vlax-get-property Xlapp "sheets") "Add") 
       "name" Name) 
 (setq Rtn (equal (vlxls-sheet-get-active xlapp) name)) 
  )) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-sheet-add *xlapp* “Sheet1”) return: T 
;;;(vlxls-sheet-add *xlapp* NIL) return: T 
;;;(vlxls-sheet-add *xlapp* “NewSheet”) return: NIL 
 
(Defun vlxls-sheet-put-active (xlapp Name / sh);;;設置當前使用頁 
  (if (null (vlxls-sheet-add xlapp name)) 
    (vlax-for sh    (vlax-get-property Xlapp "sheets") 
      (if (= (vlax-get-property sh "Name") Name) 
        (vlax-invoke-method sh "Activate") 
        ) 
      ) 
    ) 
  (equal (vlxls-sheet-get-active xlapp) name) 
  ) 
;;;Examples: 
;;;(vlxls-sheet-put-active *xlapp* “Sheet1”) return: T 
;;;(vlxls-sheet-put-active *xlapp* “NewSheet”) return: T 
 
(Defun vlxls-sheet-get-UsedRange (xlapp Name / sh Rtn);;;取得使用頁的使用范圍 
  (if (null Name) 
     (setq Name (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'Name)) 
    ) 
 (vlax-for sh (vlax-get-property Xlapp "sheets") 
   (if   (= (vlax-get-property sh "Name") Name) 
     (setq Rtn (vlax-get-property sh "UsedRange"))) 
   ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-sheet-get-usedrange *xlapp* “Sheet1”) return: T 
;;;(vlxls-sheet- get-usedrange *xlapp* “NewSheet”) return: T 
 
(Defun vlxls-cellid (id / xx id1 id2 Rtn) ;;;;cell id 轉換 
  (if (= (type id) 'list) 
    (setq id (vlxls-rangeid id)) 
    ) 
  (setq id (strcase id)) 
  (if (null (setq xx (vl-string-search ":" id))) 
  (setq Rtn (list id "")) 
  (setq id1 (substr id 1 xx) 
        id2 (substr id (+ xx 2)) 
        id1 (vlxls-rangeid id1) 
        id2 (vlxls-rangeid id2) 
        Rtn (list (vlxls-rangeid (list (min (car id1) (car id2)) 
   (min (cadr id1) (cadr id2)))) 
                  (vlxls-rangeid (list (max (car id1) (car id2)) 
                                       (max (cadr id1) (cadr id2))))) 
        ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cellid ‘(3 14)) return: ("C14" "") 
;;;(vlxls-cellid “D23”) return: ("D23" "") 
;;;(vlxls-cellid “C12:F3”) return: ("C3" "F12") 
;;;(vlxls-cellid “F15:G22”) return: ("F15" "G22") 
 
(Defun vlxls-rangeid (id / str->list list->str xid->str Rtn) ;;;;range id 轉換 
  (Defun str->list1 (str / ii xk xv rr pos x y) 
   (setq rr (strlen str)) 
    (foreach ii     '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") 
     (if (setq pos (vl-string-search ii str)) 
       (setq rr (min pos rr)) 
       ) 
      ) 
    (setq x (substr str 1 rr) 
          y (substr str (1+ rr)) 
          ) 
    (if    (= (strlen x) 2) 
      (setq xk (- (ascii (substr x 1 1)) 64) 
            xv (- (ascii (substr x 2)) 64) 
            ) 
      (setq xk 0 
            xv (- (ascii x) 64) 
            ) 
      ) 
    (list (+ (* xk 26) xv) (read y)) 
    ) 
  (Defun xid->str (IntNum / PosNum Nm-One) 
    (setq Nm-One (1- IntNum) 
          PosNum (/ Nm-One 26) 
          ) 
    (if    (= PosNum 0) 
      (chr (+ 65 (rem Nm-One 26))) 
      (strcat (chr (+ 64 PosNum)) (chr (+ 65 (rem Nm-One 26)))) 
      ) 
    ) 
(Defun list->str1 (idr / x y) 
  (setq x (car idr) 
        y (cadr idr) 
        x (xid->str x) 
        y (itoa y) 
        ) 
  (strcat x y) 
  ) 
(cond  ((= (type id) 'str) (setq Rtn (str->list1 id))) 
       ((= (type id) 'list) (setq Rtn (list->str1 id))) 
       ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-rangeid ‘(3 14)) return: "C14" 
;;;(vlxls-rangeid “D23”) return: (4 23) 
;;;(vlxls-rangeid “DD23”) return: (108 23) 
 
(Defun vlxls-range-autofit (range);;自動調整范圍內存儲格 
      (equal (vlax-variant-value 
               (msxl-autofit 
                 (msxl-get-columns (msxl-get-Cells range)) 
                 ) 
               ) 
             :vlax-true 
             ) 
  ) 
;;;Examples: 
;;;(vlxls-range-autofit (msxl-get-range *xlapp* “C12:F15”)) return: T 
;;;(vlxls-range-autofit RangeObject) return: NIL 
 
(Defun vlxls-cell-put-active (xl id / Rtn);;范圍內激活 
  (if (= (type id) 'list) 
    (setq id (vlxls-rangeid id)) 
    ) 
  (msxl-activate (setq Rtn (msxl-get-range xl id))) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cell-put-active *xlapp* “C12:F15”) return: #<VLA-OBJECT Range 09d1998c> 
;;;(vlxls-cell-put-active *xlapp* “F12”) return: #<VLA-OBJECT Range 06c389a2> 
 
(Defun vlxls-cell-get-value (xl id);;取得范圍內值并列表 
  (if (= (type id) 'list) 
    (setq id (vlxls-rangeid id)) 
    ) 
  (vlxls-variant->list 
    (msxl-get-value2 (msxl-get-range xl id)) 
    ) 
  ) 
;;;Examples: 
;;;(vlxls-cell-get-value *xlapp* “C12”) return: “g” 
;;;(vlxls-cell-get-value *xlapp* “C12:C12”) return: “g” 
;;;(vlxls-cell-get-value *xlapp* “C12:C15”) return: (("g") ("") ("") ("")) 
;;;(vlxls-cell-get-value *xlapp* “C12:F12”) return: (("g" "ds" "" "")) 
;;;(vlxls-cell-get-value *xlapp* “C12:F15”) return: (("g" "ds" "" "") ("" "" "g" "") ("" "" "" "") ("" "" "" "")) 
 
(Defun vlxls-cell-put-value (xl id Data / vllist-explode idx xx yy ary Rtn) 
  ;;;;;將信息輸入區域內 
  (Defun vllist-explode1 (lst) 
    (cond ((not lst) nil) 
          ((atom lst) (list lst)) 
          ((append (vllist-explode1 (car lst)) 
                   (vllist-explode1 (cdr lst)) 
                   ))) 
    ) 
  (if (null id) 
    (setq id "A1") 
    ) 
  (if (= (type id) 'list) 
    (setq id (vlxls-rangeid id)) 
    ) 
  (if (= (type (car Data)) 'LIST) 
    (setq ARY (vlax-make-safearray 
                vlax-vbstring(cons 0 (1- (length Data))) 
                (cons 1 (length (car Data))) 
                ) 
          XX  (1- (length (car Data))) 
          YY  (1- (length Data)) 
          ) 
    (setq ARY (vlax-make-safearray 
                vlax-vbstring 
                (cons 0 1) 
                (cons 1 (length Data)) 
                ) 
          XX  (1- (length Data)) 
          YY  0) 
    ) 
  (if (= xx yy 0) 
    (msxl-put-value2 
      (setq Rtn (msxl-get-range xl id)) 
      (car (vllist-explode1 data)) 
      ) 
    (progn 
      (setq id (vlxls-cellid-calc id xx yy)) 
      (msxl-put-value2 
        (setq Rtn (msxl-get-range xl id)) 
        (vlax-safearray-fill ary data) 
        ) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cell-put-value *xlapp* “C12” “xx”) return: #<VLA-OBJECT Range 093a7764> 
;;;(vlxls-cell-put-value *xlapp* “C12:F3” “xx”) return: #<VLA-OBJECT Range 43c5ac64> 
;;;(vlxls-cell-put-value *xlapp* “C12:D13” ‘((“zz” “xx”)(“xx” “zz”))) ereturn: 
 
(Defun vlxls-cellid-calc (id x y / idx) ;;;計算范圍 
  (setq   id  (car (vlxls-cellid id)) 
          idx (vlxls-rangeid id) 
          x   (+ x (car idx)) 
          x   (if    (< x 1) 
                1 
                x) 
          y   (+ y (cadr idx)) 
          y   (if    (< y 1) 
                1 
                y) 
          idx (vlxls-rangeid (list x y)) 
          id  (vlxls-cellid (strcat id ":" idx)) 
          id  (strcat (car id) ":" (cadr id)) 
          ) 
  id 
  ) 
;;;Examples: 
;;;(vlxls-cellid-calc “C12” 2 20) return: "C12:E32" 
;;;(vlxls-cellid-calc ‘(2 23) 2 -120) return: "B1:D23" 
 
(Defun vlxls-get-row-value (xl id len / vllist-explode Rtn);;取出單列的內容 
  (Defun vllist-explode4  (lst) 
    (cond ((not lst) nil) 
          ((atom lst) (list lst)) 
          ((append (vllist-explode4 (car lst)) 
                   (vllist-explode4 (cdr lst)) 
                   ) 
           ) 
          ) 
    ) 
  (if (> len 0) 
    (setq id (vlxls-cellid-calc id (1- len) 0)) 
    (setq id (vlxls-cellid-calc id (1+ len) 0)) 
    ) 
  (setq Rtn (vllist-explode4 (vlxls-cell-get-value xl id))) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-get-row-value *xlapp* “C12” 2) return: ("zz" "xxx") 
;;;(vlxls-get-row-value *xlapp* “C12” -20) return: ("" "" "zz") 
 
(Defun vlxls-put-row-value (xl id data flg / Rtn);;;單列輸入信息并且flg為t則自動調整尺寸 
  (if (= (type data) 'str) 
    (setq data (list data)) 
    ) 
  (setq   id (car (vlxls-cellid id)) 
          id (vlxls-cellid-calc id (1- (length data)) 0) 
          ) 
  (setq Rtn (vlxls-cell-put-value xl id (list data))) 
  (if flag 
  (vlxls-range-autofit 
    rtn 
    )) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-put-row-value *xlapp* “C12” “abc”) return:#<VLA-OBJECT Range 2a621cac> 
;;;(vlxls-put-row-value *xlapp* ‘(12 3) “abc”) return:#<VLA-OBJECT Range 7a36c491> 
;;;(vlxls-put-row-value *xlapp* “C12” ‘("zz" "xxx")) return:#<VLA-OBJECT Range 09d1da1c> 
;;;(vlxls-put-row-value *xlapp* ‘(12 3) ‘("zz" "xxx")) return:#<VLA-OBJECT Range 0a26c4f3> 
 
(Defun vlxls-get-column-value (xl id len / vllist-explode Rtn);;取出單欄信息 
  (Defun vllist-explode3       (lst) 
    (cond ((not lst) nil) 
          ((atom lst) (list lst)) 
          ((append (vllist-explode3 (car lst)) 
                   (vllist-explode3 (cdr lst)) 
                   ) 
           ) 
          ) 
    ) 
  (setq id (car (vlxls-cellid id))) 
  (if (> len 0) 
    (setq id (vlxls-cellid-calc id 0 (1- len))) 
    (setq id (vlxls-cellid-calc id 0 (1+ len))) 
    ) 
  (setq Rtn (vllist-explode3 (vlxls-cell-get-value xl id))) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-get-column-value *xlapp* “C12” 2) return: ("zz" "sdfsdf") 
;;;(vlxls-get-column-value *xlapp* “C12” -20) return: ("" "" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "zz") 
 
(Defun vlxls-put-column-value (xl id data flg / item Rtn);;;單欄輸入信息并且flg為t則自動調整尺寸 
  (if (= (type data) 'str) 
    (setq data (list data)) 
    ) 
  (setq   id (car (vlxls-cellid id)) 
          id (vlxls-cellid-calc id 0 (1- (length data))) 
          ) 
 (foreach item    data 
   (setq Rtn (cons (list item) Rtn))) 
  (setq Rtn (vlxls-cell-put-value xl id (reverse Rtn))) 
 (if flg 
   (vlxls-range-autofit 
    rtn 
   )) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-put-column-value *xlapp* “C12” “abc”) return: #<VLA-OBJECT Range 049c521b> 
;;;(vlxls-put-column-value *xlapp* ‘(12 3) “abc”) return: #<VLA-OBJECT Range 0235cba1> 
;;;(vlxls-put-column-value *xlapp* “C12” ‘("zz" "xxx")) return: #<VLA-OBJECT Range 09d1da1c> 
;;;(vlxls-put-column-value *xlapp* ‘(12 3) ‘("zz" "xxx")) return: #<VLA-OBJECT Range 0a26c4f3> 
 
(Defun vlxls-cell-get-aci (xl id) 
  (vlxls-color-eci->aci 
    (vlax-variant-value 
      (msxl-get-colorindex 
        (msxl-get-interior (msxl-get-range xl id)) 
        ) 
      ) 
    ) 
  ) 
;;;Examples: 
;;;(vlxls-cell-get-aci *xlapp* “C12”) return:256 
;;;(vlxls-cell-get-aci *xlapp* ‘(12 3)) return:15 
 
(Defun vlxls-cell-put-aci (xl id aci / Rtn) 
  (if (null aci) 
    (msxl-put-colorindex 
      (msxl-get-interior (setq Rtn (msxl-get-range xl id))) 
      (vlax-make-variant -4142) 
      ) 
    (msxl-put-colorindex 
      (msxl-get-interior (setq Rtn (msxl-get-range xl id))) 
      (vlxls-color-aci->eci aci) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cell-put-aci *xlapp* “C12” 6) return: #<VLA-OBJECT Range 09d1369c> 
;;;(vlxls-cell-put-aci *xlapp* “C12” nil) return: #<VLA-OBJECT Range 09d1369c> 
 
(Defun vlxls-text-get-aci (xl id) 
  (vlxls-color-eci->aci 
    (vlax-variant-value 
      (msxl-get-colorindex 
        (msxl-get-font (msxl-get-range xl id)) 
        ) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-text-get-aci *xlapp* “C12”) return: 256 
;;;(vlxls-text-get-aci *xlapp* ‘(12 3)) return: 15 
 
(Defun vlxls-text-put-aci (xl id aci / Rtn) 
   (if (null aci) 
     (msxl-put-colorindex 
       (msxl-get-font (setq Rtn (msxl-get-range xl id))) 
       (vlax-make-variant -4105) 
       ) 
     (msxl-put-colorindex 
       (msxl-get-font (setq Rtn (msxl-get-range xl id))) 
       (vlxls-color-aci->eci aci) 
       ) 
     ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-text-put-aci *xlapp* “C12” 6) return: #<VLA-OBJECT Range 09d1369c> 
;;;(vlxls-text-put-aci *xlapp* “C12” nil) return: #<VLA-OBJECT Range 09d1369c> 
 
(Defun vlxls-text-get-prop(xl id / Cell Font DXF1 DXF7 DXF40 DXF72 DXF62 DXF420 Rtn) 
  ;;;;取得單元格文字相關信息 
  (setq   id     (car (vlxls-cellid id)) 
          cell   (msxl-get-range xl id) 
          font   (msxl-get-font cell) 
          DXF7   (vlax-variant-value (msxl-get-name Font)) 
          DXF40  (vlax-variant-value (msxl-get-size Font)) 
          DXF72  (vlax-variant-value (msxl-get-HorizontalAlignment Cell) 
                   ) 
          DXF72  (cond ((= DXF72 -4152) 11) 
                       ((= DXF72 -4108) 10) 
                       (t 9) 
                       ) 
          DXF62  (vlxls-color-eci->aci 
                   (vlax-variant-value (msxl-get-colorIndex Font)) 
                   ) 
          DXF420 (vlxls-color-eci->truecolor 
                   (vlax-variant-value (msxl-get-colorIndex Font))) 
          Rtn    (list (cons 0 (strcase id)) 
                       (cons 7 DXF7)(cons 40 DXF40)(cons 62 DXF62) 
                       (cons 72 DXF72)(cons 420 DXF420))) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-text-get-prop *xlapp* “C12”) return:((0 . "C12") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 9) (420 . 16711935)) 
;;;(vlxls-text-get-prop *xlapp* ‘(2 10)) return:((0 . "B10") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 11) (420 . 16711935)) 
 
(Defun vlxls-cell-get-prop(xl id / range left top width height dxf10 Rtn) 
  ;;;;取得單元格信息 
  (if (vlxls-cell-merge-p xl id) 
     (setq id (vlxls-cell-get-mergeid xl id)) 
    ) 
  (setq   range  (msxl-get-range xl id) 
          left   (vlax-variant-value (msxl-get-left Range)) 
          top    (vlax-variant-value (msxl-get-top Range)) 
          width  (vlax-variant-value (msxl-get-width Range)) 
          height (vlax-variant-value (msxl-get-height Range)) 
          dxf10  (list left top) 
          Rtn    (list (cons 0 (strcase id)) 
                       (cons 1 (vlxls-cell-get-value xl id)) 
                       (cons 10 dxf10) 
                       (cons 41 width) 
                       (cons 42 height) 
                       (cons -1 (vlxls-text-get-prop xl id)) 
                       ) 
          ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cell-get-prop *xlapp* “C12:F14”) return:((0 . "C12:F14") (1 ("zz" "xxx" "xxx" "xxx") ("sdfsdf" "sdfsdf" "sdfsdf" "sdfsdf") 
;;;          ("sdfsdf" "sdfsdf" "sdfsdf" "sdfsdf")) (10 108.0 156.75) (41 . 156.0) (42 . 42.75) (-1 (0 . "C12") (7 . "Arial") 
;;;          (40 . 12.0) (62 . 256) (72 . 9) (420 . 16711935))) 
;;;(vlxls-cell-get-prop *xlapp* “B8”) return: ((0 . "B8") (1 . "sdg") (10 54.0 99.75) (41 . 54.0) (42 . 14.25) (-1 (0 . "B8") 
;;;    (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 10) (420 . 16711935))) 
 
(Defun vlxls-cell-border (xl id flg / bdr);;;外框線 
  (if flg 
    (msxl-put-value 
      (msxl-get-borders 
        (msxl-get-range xl id) 
        ) 
      1 
      ) 
    (msxl-put-value 
      (msxl-get-borders 
        (msxl-get-range xl id) 
        ) 
      'linestyle 
        msxl-xlnone 
      ) 
    ) 
  ) 
;;;Examples: 
;;;(vlxls-cell-border *xlapp* “C12:F14” T) return:NIL 
;;;(vlxls-cell-border *xlapp* “B8” NIL) return:NIL 
 
(Defun vlxls-cell-merge      (xl id / vllist-explode Val Rtn) 
  ;;;;;;;;;合并單元格 
  (Defun vllist-explode2       (lst) 
    (cond ((not lst) nil) 
          ((atom lst) (list lst)) 
          ((append (vllist-explode2 (car lst)) 
                   (vllist-explode2 (cdr lst)) 
                   ) 
           ) 
          ) 
    ) 
  (setq val (vllist-explode2 (vlxls-cell-get-value xl id))) 
  (while (vl-position "" val) 
    (setq val (vl-remove "" val)) 
    ) 
  (setq   val (car val) 
          Rtn (msxl-get-range xl id) 
          ) 
  (msxl-clear Rtn) 
  (msxl-merge Rtn nil) 
  (msxl-put-value2 Rtn Val) 
  (msxl-put-HorizontalAlignment Rtn -4108) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cell-merge *xlapp* “C12:F14”) return: #<VLA-OBJECT Range 0023ab7c> 
 
(Defun vlxls-cell-unmerge (xl id / Rtn);;;取消合并單元格 
  (if (vlxls-cell-merge-p xl id) 
    (progn 
      (vlax-invoke-method (msxl-get-range xl id) 'unmerge) 
      (setq Rtn (msxl-get-range xl id)) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cell-unmerge *xlapp* “C12:F14”) return:#<VLA-OBJECT Range 0023ab7c> 
;;;(vlxls-cell-unmerge *xlapp* “E14”) return:#<VLA-OBJECT Range 09ce72e4> 
 
(Defun vlxls-cell-merge-p (xl id);;;判斷單元格是否合并 
  (equal (vlax-variant-value 
           (msxl-get-mergecells (msxl-get-range xl id)) 
           ) 
         :vlax-true 
         ) 
  ) 
;;;Examples: 
;;;(vlxls-cell-merge-p *xlapp* “C12:F14”) return:T 
;;;(vlxls-cell-merge-p *xlapp* “E14”) return:NIL 
 
(Defun vlxls-cell-get-mergeid (XL ID / Rtn);;;取得單元格合并的范圍 
  (if (vlxls-cell-merge-p xl id) 
    (progn 
      (msxl-select (msxl-get-range xl id)) 
      (setq Rtn (vlxls-range-getid (msxl-get-selection xl))) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-cell-get-mergeid *xlapp* “C12:F14”) return: "B9:G19” 
;;;(vlxls-cell-get-mergeid *xlapp* “E14”) return: "A11:G19 
 
(Defun vlxls-range-getID (range / col row dx dy);;;取得單元格地址 
  (setq   dx  (vlxls-get-property range "MergeArea.Rows.Count") 
          dy  (vlxls-get-property range "MergeArea.Columns.Count") 
          row (vlxls-get-property range "MergeArea.Row") 
          col (vlxls-get-property range "MergeArea.Column") 
          ) 
  (strcat (vlxls-rangeid (list col row)) 
          ":" 
          (vlxls-rangeid (list (1- (+ col dy)) (1- (+ row dx))))) 
) 
;;;Examples: 
;;;(vlxls-range-getid RangeObject) return: ”C12:G19” 
;;;(vlxls-range-getid RangeObject) return: ”B16:B16” 
 
(Defun vlxls-range-size      (range / xl row col rrr ccc xxx yyy);;;;取得單元范圍尺寸 
  (setq   xl  (msxl-get-parent range) 
          Row (msxl-get-count (msxl-get-rows Range)) 
          Col (msxl-get-count (msxl-get-columns Range)) 
          RRR (1- (msxl-get-row Range)) 
          CCC (msxl-get-column Range) 
          ) 
  (repeat Row 
    (setq yyy (cons   (vlax-variant-value 
                        (msxl-get-height 
                          (msxl-get-range 
                            xl 
                            (vlxls-rangeid (list CCC (setq RRR (1+ RRR)))) 
                            ) 
                          ) 
                        ) 
                      yyy 
                      ) 
          ) 
    ) 
  (setq   RRR (msxl-get-row Range) 
          CCC (1- (msxl-get-column Range)) 
          ) 
  (repeat Col 
    (setq xxx (cons   (vlax-variant-value 
                        (msxl-get-width 
                          (msxl-get-range 
                            xl 
                            (vlxls-rangeid (list (setq CCC (1+ CCC)) RRR)) 
                            ) 
                          ) 
                        ) 
                      xxx 
                      ) 
          ) 
    ) 
  (list (reverse xxx) (reverse yyy)) 
  ) 
;;;Examples: 
;;;(vlxls-range-size RangeObject) return: ((27.0 27.0 110.25 51.0 69.75) (14.25 14.25 14.25 14.25 14.25 57.0 14.25)) 
 
(Defun vlxls-Rangevalue->SafeArray (Data / XSub_GetXY XSub_GetMinMaxID xsub-MergeID->List 
                                    MinID MaxID ID ID1 ID2 IDN X minid xy Y Rtn Item) 
  ;;;;;;;;;;;;;安全數組 
  (Defun xsub-MergeID->List1 (ID / KK ID1 ID2 IDX IDY Rtn) 
    (Setq ID (strcase ID)) 
    (if    (setq KK (vl-string-search ":" ID)) 
      (setq ID1   (substr ID 1 KK) 
            ID2  (substr ID (+ 2 KK)) 
            ) 
      (setq ID1   ID 
            ID2  ID) 
      ) 
    (setq ID1 (vlxls-rangeid ID1) 
          ID2 (vlxls-rangeid ID2) 
          IDX (vlxls-rangeid 
                (list (min (nth 0 ID1) (nth 0 ID2)) 
                      (min (nth 1 ID1) (nth 1 ID2)) 
                      ) 
                ) 
          IDY 
           (vlxls-rangeid 
             (list (max (nth 0 ID1) (nth 0 ID2)) 
                   (max (nth 1 ID1) (nth 1 ID2)) 
                   ) 
             ) 
          Rtn (list IDX IDY) 
          ) 
    Rtn 
    ) 
  (Defun XSub_GetXY1 (ID SID / S10 S11 DX DY Rtn) 
    (setq S10 (nth 0 MinID) 
          S11 (nth 1 MinID) 
          ID  (vlxls-rangeid ID) 
          DX  (- (nth 0 ID) S10) 
          DY  (- (nth 1 ID) S11) 
          Rtn (list DX DY) 
          ) 
    Rtn 
    ) 
  (Defun XSub_GetMinMaxID1 (ID1 ID MinorMax / X Y X1 Y1 Rtn) 
    (if    (null ID) 
      (setq Rtn ID1) 
      (progn 
        (setq ID1 (vlxls-rangeid ID1) 
              ID  (vlxls-rangeid ID) 
              X1  (nth 0 ID1) 
              Y1  (nth 1 ID1) 
              X    (nth 0 ID) 
              Y   (nth 1 ID) 
              ) 
        (if (null MinorMax) 
          (setq Rtn (vlxls-rangeid (list (min X X1) (min Y Y1)))) 
          (setq Rtn (vlxls-rangeid (list (max X X1) (max Y Y1)))) 
          ) 
        ) 
      ) 
    Rtn 
    ) 
  (foreach Item    Data 
    (setq ID (strcase (car Item))) 
    (if    (vl-string-search ":" ID) 
      (setq IDN (xsub-MergeID->List1 ID)) 
      (setq IDN (list ID)) 
      ) 
    (foreach ID    IDN 
      (setq MinID (XSub_GetMinMaxID1 ID MinID nil) 
            MaxID (XSub_GetMinMaxID1 ID MaxID T) 
           ) 
      ) 
    ) 
  (setq   MinID (vlxls-rangeid MinID) 
          MaxID (vlxls-rangeid MaxID) 
          X     (- (nth 0 MaxID) (nth 0 MinID)) 
          Y     (- (nth 1 MaxID) (nth 1 MinID)) 
          Rtn   (vlax-make-safearray 
                  vlax-vbstring 
                  (cons 0 Y) 
                  (cons 1 (1+ X)) 
                  ) 
          ) 
  (foreach Item    Data 
    (setq ID (strcase (car Item))) 
    (if    (vl-string-search ":" ID) 
      (setq IDN (xsub-MergeID->List1 ID)) 
      (setq IDN (list ID)) 
      ) 
    (foreach ID    IDN 
      (setq XY (XSub_GetXY1 ID MinID)) 
      (vlax-safearray-put-element 
        Rtn 
        (nth 1 XY) 
        (1+ (nth 0 XY)) 
        (cdr Item) 
        ) 
      ) 
    ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-rangevalue->safearray ‘((“A1” . “aaa”)(“B4” . “ccc”))) return: #<safearray...> 
;;;(vlxls-variant->list (vlxls-rangevalue->safearray '(("A1" . "aaa")("B4" . "ccc")))) return: (("aaa" "") ("" "") ("" "") ("" "ccc")) 
 
(Defun vlxls-get-property (top prop / item Rtn);vlstring->list 
  ;;;;取得多重屬性 
  (Defun vlstring->list (str st / lst e) 
    (setq str (strcat str st)) 
    (while (vl-string-search st str) 
      (setq 
        lst 
         (append lst (list (substr str 1 (vl-string-search st str)))) 
        ) 
      (setq 
        str 
         (substr str (+ (1+ (strlen st)) (vl-string-search st str))) 
        ) 
      ) 
    (if    lst 
      (mapcar '(lambda (e) (vl-string-trim " " e)) lst) 
      ) 
    ) 
  (cond  ((= (type prop) 'sym) 
          (setq Rtn (vlax-get-property top prop)) 
          ) 
         ((= (type prop) 'str) 
          (if (null (vl-string-search "." prop)) 
            (setq Rtn (vlax-get-property top prop)) 
            (foreach item (vlstring->list prop ".") 
              (if (null Rtn) 
                (setq Rtn (vlax-get-property top item)) 
                (setq Rtn (vlax-get-property Rtn item)) 
                )))) 
         ) 
  (cond  ((= (type Rtn) 'variant) 
          (setq Rtn (vlax-variant-value Rtn)) 
          ) 
         ((= (type Rtn) 'safearray) 
          (setq Rtn (vlxls-variant->list Rtn)) 
          ) 
         ) 
  Rtn 
  ) 
;;;Examples: 
;;;(vlxls-get-property RangeObject “Application.ActiveSheet.Name”) return: ”Sheet1” 
;;;(vlxls-get-property RangeObject “MergeArea.Columns.Count”) return: 3 
 
(setq *xls-color* 
       (list (list 1 18 0) 
             (list 2 7 1677215) 
             (list 3 1 16711680) 
             (list 4 3 65280) 
             (list 5 5 255) 
             (list 6 2 16776960) 
             (list 7 6 16711935) 
             (list 8 4 65535) 
             (list 9 16 8323072) 
             (list 10 96 32512) 
             (list 11 176 127) 
             (list 12 56 8355584) 
             (list 13 216 8323199) 
             (list 14 136 32639) 
             (list 15 9 12566463) 
             (list 16 8 8355711) 
             (list 17 161 9476095) 
             (list 18 237 9449568) 
             (list 19 7 1677167) 
             (list 20 254 12648447) 
             (list 21 218 6291552) 
             (list 22 11 16744319) 
             (list 23 152 24768) 
             (list 24 254 13617407) 
             (list 25 176 127) 
             (list 26 6 16711935) 
             (list 27 2 16776960) 
             (list 28 4 65535) 
             (list 29 216 8323199) 
             (list 30 16 8323072) 
             (list 31 136 32639) 
             (list 32 5 255) 
             (list 33 140 51455) 
             (list 34 254 12648447) 
             (list 35 254 13631439) 
             (list 36 51 16777104) 
             (list 37 151 9488639) 
             (list 38 221 16750799) 
             (list 39 191 13605119) 
             (list 40 31 16763024) 
             (list 41 150 3105023) 
             (list 42 132 3131584) 
             (list 43 62 9488384) 
             (list 44 40 16762880) 
             (list 45 30 16750336) 
             (list 46 30 16738048) 
             (list 47 165 6317968) 
             (list 48 252 9475984) 
             (list 49 148 12384) 
             (list 50 105 3184736) 
             (list 51 98 12032) 
             (list 52 48 3158016) 
             (list 53 24 9449472) 
             (list 54 237 9449311) 
             (list 55 177 3158160) 
             (list 56 250 3092527) 
             ) 
      *Chinese* t 
      ) 
(if vl-load-com 
  (vl-load-com)) 
(if vl-arx-import 
  (foreach item    '(ACAD_COLORDLG       ACAD_truecolordlg 
                     ACAD_STRLSORT      INITDIA 
                     ACAD-POP-DBMOD     ACAD-PUSH-DBMOD 
                     STARTAPP            layoutlist 
                     ) 
    (vl-arx-import item) 
    ) 
  ) 
(setq item   nil 
      *xls-ver*     "1.1.40715" 
      ) 
(princ 
  (strcat "\n VLAE:VLXLS Freebie API Version " *xls-ver*) 
  ) 
(princ 
  "\n Copyright(C) 1994-2005 KozMos Inc. All rights reserved" 
  ) 
(princ) 
 
(defun vlxls-ScreenUpdating-Off  (*xlapp*) 
  (vlax-put-property *xlapp* 'ScreenUpdating 0)) 
(defun vlxls-ScreenUpdating-On  (*xlapp*) 
  (vlax-put-property *xlapp* 'ScreenUpdating -1)) 
 
;;************************************************************************* 
;;; 模塊： vlxls-Excel-ColumnWidth 
;;; 描述： 調整寬度col為width 
;;; 參數： sheet (object) 
;;; 示例： (vlxls-Excel-ColumnWidth xlapp 2 12);;調整B欄寬為12 
;;;************************************************************************* 
 
(defun vlxls-ColumnWidth(xlapp col width / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (vlax-put-property (setq cell (vlxls-get-cell sheet 1 col)) "ColumnWidth" 
width) 
  ) 
 
;;;************************************************************************* 
;;; 模塊： mSX-Excel-RowHeight 
;;; 描述： 調整列高row為height 
;;; 參數： sheet (object) 
;;; 示例： (mSX-Excel-ColumnWidth xlapp 3 15);;調整3列高為15 
;;;************************************************************************* 
 
(defun vlxls-RowHeight(xlapp row height / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (vlax-put-property (setq cell (vlxls-get-cell sheet row 1)) "RowHeight" 
height) 
  ) 
 
(defun vlxls-get-cell  (obj row col / item cells) 
  (setq item (vlax-get-property 
    (setq cells (vlax-get-property obj "Cells")) 
    "Item" 
    (vlax-make-variant row) 
    (vlax-make-variant col))) 
  (vlax-release-object cells) 
  (vlax-variant-value item)) 
 
(defun vlxls-put-pagesetup(xlapp top bot lef rig hea fot flh flv);;設置版面 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (setq page (vlax-get-property sheet "pagesetup")) 
  (vlax-put-property page "footermargin" (* fot 28.3465)) 
  (vlax-put-property page "headermargin" (* hea 28.3465)) 
  (vlax-put-property page "leftmargin" (* lef 28.3465)) 
  (vlax-put-property page "rightmargin" (* 28.3465 rig)) 
  (vlax-put-property page "topmargin" (* top 28.3465)) 
  (vlax-put-property page "bottommargin" (* bot 28.3465)) 
  (vlax-put-property page "CenterHorizontally" (* 28.3465 flh)) 
  (vlax-put-property page "CenterVertically" (* flv 28.3465)) 
  ) 
 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-cellfontname 
;;; 描述： 更改單元格字體 
;;; 參數： row col name 
;;; 示例： (vlxls-Excel-cellfontname 2 3 "新細明體");;更改單元格C2字體為"新細明體" 
;;;************************************************************************* 
 
(defun vlxls-Excel-cellfontname(xlapp row col name / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (vlax-put-property(vlax-get-property (setq cell (msx-get-cell sheet row col)) "font" 
) "name" name 
  )) 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-cellcolor 
;;; 描述： 更改單元格顏色 
;;; 參數： row col color 
;;; 示例： (vlxls-Excel-cellcolor2 3 14);;更改單元格C2為14號色 
;;;************************************************************************* 
 
(defun vlxls-Excel-cellcolor(xlapp row col color / sheet cell) 
  (setq sheet (vlax-get-property xlapp  "ActiveSheet")) 
  (setq cell (vlxls-get-cell sheet row col)) 
  (msxl-put-ColorIndex (msxl-get-Interior cell) color)) 
 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-textcolor 
;;; 描述： 更改單元格文字顏色 
;;; 參數： row col color 
;;; 示例： (vlxls-Excel-textcolor 2 3 14);;更改單元格C2文字為14號色 
;;;************************************************************************* 
 
(defun vlxls-Excel-textcolor(xlapp row col color / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (setq cell (vlxls-get-cell sheet row col)) 
  (vlax-put-property (vlax-get-property cell "font") "ColorIndex" color)) 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-textsize 
;;; 描述： 更改單元格文字大小 
;;; 參數： row col size 
;;; 示例： (vlxls-Excel-textsize 2 3 18);;更改單元格C2文字為18號字大小 
;;;************************************************************************* 
 
(defun vlxls-Excel-textsize(xlapp row col size / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (setq cell (vlxls-get-cell sheet row col)) 
  (vlax-put-property (vlax-get-property cell "font") "Size" size)) 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-textunderline 
;;; 描述： 更改單元格文字下畫線 
;;; 參數： row col size 
;;; 示例： (vlxls-Excel-textunderline 2 3 1);;更改單元格C2文字無下划線 
;;;************************************************************************* 
 
(defun vlxls-Excel-textunderline(xlapp row col underline / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (setq cell (vlxls-get-cell sheet row col)) 
  (vlax-put-property (vlax-get-property cell "font") "Underline" underline)) 
;;;;;注:   underline 1---------無下划線 
;;;;;                2---------單線 
;;;;;                3---------雙線 
;;;;;                4---------會計用單線 
;;;;;                5---------會計用雙線 
 
 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-fontstyle 
;;; 描述： 更改單元格文字形式 
;;; 參數： row col color 
;;; 示例： (vlxls-Excel-fontstyle 2 3 "粗體");;更改單元格C2文字為14粗體 
;;;************************************************************************* 
 
(defun vlxls-Excel-fontstyle(xlapp row col style / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (setq cell (vlxls-get-cell sheet row col)) 
  (vlax-put-property (vlax-get-property cell "font") "FontStyle" style)) 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-fontspecial 
;;; 描述： 更改單元格文字特殊效果 
;;; 參數： row col color 
;;; 示例： (vlxls-Excel-fontspecial 2 3 "Strikethrough" item);;更改單元格C2文字特殊效果為刪線 
;;;        "Superscript"為上標 "Subscript" 為下標 (item設置為0則停用,-1為啟用) 
;;;************************************************************************* 
 
(defun vlxls-Excel-fontspecial(xlapp row col special item / sheet cell) 
  (setq sheet (vlax-get-property xlapp "ActiveSheet")) 
  (setq cell (vlxls-get-cell sheet row col)) 
  (vlax-put-property (vlax-get-property cell "font") special item)) 
;;;************************************************************************* 
;;; 模塊： vlxls-Excel-textAlignment 
;;; 描述： 更改單元格文字對齊方式 
;;; 參數： row col color hal val 
;;; 示例： (vlxls-Excel-textAlignment 2 3 1 -4108);;更改單元格C2文字對齊方式水平方向一般﹐垂直置中 
;;;************************************************************************* 
 
(defun vlxls-Excel-textAlignment(xlapp row col hal val / sheet cell) 
  (setq sheet (vlax-get-property xlapp  "ActiveSheet")) 
  (setq cell (vlxls-get-cell sheet row col)) 
  (vlax-put-property  cell  "HorizontalAlignment" hal) 
  (vlax-put-property  cell  "VerticalAlignment" val)) 
 
;;;注:水平方式  1    ----------一般                
;;;;;;;;;      -4131----------左縮排 ;;;;或2 
;;;;;;;;;      -4108----------置中對齊 ;;或3 
;;;;;;;;;      -4152----------靠右對齊 ;;或4 
;;;;;;;;;      5    ----------填滿     ;;或5 
;;;;;;;;;      -4130----------水平對齊 ;;或6 
;;;;;;;;;          7----------跨欄置中   
;;;;;;;;;      -4117----------分散對齊  ;;或8 
 
;;;注:垂直方式  -4160 ----------靠上        或1       
;;;;;;;;;       -4108----------置中對齊     或2 
;;;;;;;;;       -4107----------靠下         或3 
;;;;;;;;;       -4130----------垂直對齊     或4 
;;;;;;;;;       -4117 ----------分散對齊    或5

此乃本人积累下来的一些小小经验.希望对大家有用,因公司
用的是繁体系统,故以上有些文字为繁体望见谅,大家可以自己回
去转化一下!

rungang2002 · 发表于 2005-3-26 21:49:53

太有用了.

ssktw · 发表于 2005-3-26 21:53:29

正发愁呢，就来了，谢谢

伊伊哎哎 · 发表于 2005-3-27 01:24:11

强烈要求给楼主加分,呵呵,楼主该感谢我一下了...

你现在中山还好吗?看到此信息加我QQ:22903161
手机号改了,QQ上联系

gdqbx · 发表于 2005-3-27 15:53:46

如何使用，请高手指点！

舟自横 · 发表于 2005-3-28 10:08:47

和普通LISP一样调用啊!只是你的电脑上必须有装EXCEL软件!
你可以逐个试一下就知道怎样用了!你可以参考每个子程序后面的
EXAMPLE啊!

bestgoodbetter · 发表于 2005-4-2 20:13:43

多谢高手的好东东！
我正缺这方面的东西！
谢谢了！

FLOODITIDE · 发表于 2005-4-2 23:32:54

有些复杂，下回来学习

chen4 · 发表于 2005-4-3 15:48:29

hojing7 · 发表于 2005-4-3 23:49:24

你的ㄧ小步卻是我的ㄧ大步
感謝你的分享

周山 · 发表于 2005-4-4 07:53:42

我对LISP还不熟,不过以后还可以慢慢学习.

警告：请不要发表和主题无关的帖子！

lxch · 发表于 2005-4-4 08:09:01

虽然现在还不太明白，先下了。谢谢。

liuyj · 发表于 2005-4-25 16:42:20

你指的是哪一部分是自己开发的？好像很多东西都在这儿呢。
http://www.ikozmos.com/

lxy_2080 · 发表于 2014-5-19 14:44:58

留名占位。以后好找。哈哈

yhly555 · 发表于 2014-8-27 16:57:49

这个很给力

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：VLISP操作EXCEL函数库大全..

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子