;;;;;;;;此為經整理過后一些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小时内删除。