;;;;;;;;此為經整理過后一些VLISP調用EXCEL常用公共函數;;;;;;;;;;;;
;;;;;;;;此為私人函數未經許可請勿...............................
;;;;;;;;開發:朱衛星 2005/02/
;;;;;;;;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)))
)
getsavefilename (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獲取更多的解決方案\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 yota@ikozmos\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-"
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论