[求助]：cad与excal互换的lisp,内有源码!!!请各位高手修改

xuhucheng

;|Copyright(C) 1994-2005 by KozMos Inc.



Permission to use, copy, modify, and distribute this software for any purpose and without fee is hereby
granted, provided that the above copyright notice appears in all copies and that both that copyright notice
and the limited warranty and restricted rights notice below appear in all supporting documentation.
KozMos PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. KozMos SPECIFICALLY DISCLAIMS ANY IMPLIED
WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. KozMos, INC. DOES NOT WARRANT THAT THE OPERATION
OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.



Public Function

Name
(vlxls-variant->list VariantValue)

Usage
Convert a variant into normal Visual LISP LIST data, nested Variant and safearray will also be converted.

Input
VARIANT
Input Variant

RetVal
True
LIST
Valid Visual LISP variable value

Fail
STR
“”
|;
(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

)

;|Examples:

NONE




Color Transfer Function

Name
(vlxls-color-eci->truecolor ExcelColorIndexNumber)

Usage
Convert Excel ColorIndex number into most matched AutoCAD2004+ truecolor number (stored by DXF420).

Input
INT
Excel ColorIndex integer (0 to 56)

RetVal
True
INT
Valid AutoCAD 2004+ truecolor number

Fail
INT
16711935 for None|;

(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

)

;|Examples:

(vlxls-color-eci->truecolor 0) è16711935

(vlxls-color-eci->truecolor 1)è 0

(vlxls-color-eci->truecolor 12)è 8355584

(vlxls-color-eci->truecolor 120) è16711935




Color Transfer Function

Name
(vlxls-color-eci->aci ExcelColorIndexNumber)

Usage
Convert Excel ColorIndex number into most matched AutoCAD ACI Integer number.

Input
INT
Excel ColorIndex integer (0 to 56)

RetVal
True
INT
Valid AutoCAD ACI Integer number (0 to 256)

Fail
INT
256 for BYLAYER
|;
(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

)
;|
Examples:

(vlxls-color-eci->aci 0) è256

(vlxls-color-eci->aci 1)è 18

(vlxls-color-eci->aci 12)è 56

(vlxls-color-eci->aci 120) è256




Color Transfer Function

Name
(vlxls-color-aci->eci AutoCADColorIndexNumber)

Usage
Convert AutoCAD ColorIndex number into Excel ColorIndex .

Input
INT
AutoCAD ColorIndex integer (0 to 256)

RetVal
True
INT
Valid Excel ColorIndex number (from 1 to 56)

Fail
INT
0 for NONE
|;
(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) è0

(vlxls-color-aci->eci 1)è 3

(vlxls-color-aci->eci 12)è 0

(vlxls-color-aci->eci 120) è0




Color Transfer Function

Name
(vlxls-color-aci->truecolor AutoCADColorIndexNumber)

Usage
Convert AutoCAD ColorIndex number into most matched AutoCAD2004+ true color number (using Excel ColorIndex as
intermediary, provided for use in AutoCAD2002. In AutoCAD2004+, this can be done directly by AutoCAD.

Input
INT
AutoCAD ColorIndex integer (0 to 256)

RetVal
True
INT
Valid AutoCAD2004+ truecolor number

Fail
INT
16711935 for None
|;
(Defun vlxls-color-aci->truecolor (aci)

  (vlxls-color-eci->truecolor (vlxls-color-aci->eci aci))

)
;|
Examples:

(vlxls-color-aci-> truecolor 0) è 16711935

(vlxls-color-aci->truecolor 1)è 16711680

(vlxls-color-aci-> truecolor 12)è 16711935

(vlxls-color-aci-> truecolor 120) è 16711935




Excel Application Session Progress Function

Name
(vlxls-app-init)

Usage
Import Microsoft Excel Type Library, set prefix of "msxl-" for all of the :methods-prefix; :properties-prefix
& :constants-prefix. This function can detect Excel’s installation path automatically from Windows registry so
that it can run smoothly on any language platform of Windows and Office.

Input
NONE
No Arguments

RetVal
True
BOOLEAN
msxl-xl24HourClock

Fail
BOOLEAN
NIL
|;
(Defun vlxls-app-Init

       (/ OSVar GGG Olb8 Olb9 Olb10 TLB Out msg msg1 msg2)

  (if *Chinese*

    (setq msg  "\n 初始化微软Excel "

         msg1 "\042初始化Excel错误\042"

         msg2 (strcat

               "\042 警告"

               "\n ===="

               "\n 无法在您的计算机上检测到微软Excel软件"

               "\n 如果您确认已经安装Excel, 请发送电子邮"

               "\n 件到GuXiaolin@hxch.com.cn获取更多的解决方案\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 GuXiaolin@hxch.com.cn\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)è 33




Excel Application Session Progress Function

Name
(vlxls-app-new ShowExcelFlag)

Usage
Open a new Excel session and start a new workbook.

Input
BOOLEAN
T for display, nil for hide

RetVal
True
VLOBJ
Excel Session vla-object

Fail
BOOLEAN
NIL
|;
(Defun vlxls-app-New (UnHide / Rtn)

  (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)) è #<VLA-OBJECT _Application 001db27c>




Excel Application Session Progress Function

Name
(vlxls-app-open XLSfilename ShowExcelFlag)

Usage
Open a new Excel session to start existing XLS file.

Input
STR
XLS file name with full path, ".XLS" not needed.

BOOLEAN
T for display, nil for hide

RetVal
True
VLOBJ
Excel Session vla-object

Fail
BOOLEAN
NIL
|;
(Defun vlxls-app-open

       (XLSFile UnHide / ExcelApp WorkSheet Sheets ActiveSheet Rtn)

  (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)) è #<VLA-OBJECT _Application 001efd2c>




Excel Application Session Progress Function

Name
(vlxls-app-save ExcelSessionVLA-OBJECT)

Usage
Perform save operation in Excel.

Input
VLOBJ
Excel session vla-object

RetVal
True
BOOLEAN
T

Fail
BOOLEAN
NIL
|;
(Defun vlxls-app-save (xlapp)

  (equal (vlax-invoke-method

          (vlax-get-property Xlapp "ActiveWorkbook")

          "Save"

        )

        :vlax-true

  )

)
;|
Examples:

(vlxls-app-save *xlapp*) è T




Excel Application Session Progress Function

Name
(vlxls-app-saveas ExcelSessionVLA-OBJECT SavedFileName)

Usage
Perform saveas operation in Excel.

Input
VLOBJ
Excel session vla-object

STR
Saved XLS file name with full path

NIL for a temporary “XLS.XLS” file in current drawing path.

RetVal
True
STRING
XLS file name with full path

Fail
BOOLEAN
NIL
|;
(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) è “C:/Temp-Folder/XLS.XLS”

(vlxls-app-saveas *xlapp* “C:/Temp-Folder/XLS.XLS”) è “C:/Temp-Folder/XLS.XLS”

(vlxls-app-saveas *xlapp* nil) è NIL




Excel Application Session Progress Function

Name
(vlxls-app-quit ExcelSessionVLA-OBJECT SavedFlag)

Usage
Quit active workbook of Excel session and release Excel application.

Input
VLOBJ
Excel session vla-object

BOOLEAN
Save Excel active workwook flag, T for save, NIL for unsave

RetVal
True
BOOLEAN
NIL

Fail
BOOLEAN
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) è nil




Excel Application Session Progress Function

Name
(vlxls-app-kill)

Usage
Close all active Excel workbooks.

Input
NONE
No Arguments

RetVal
True
BOOLEAN
NIL

Fail
BOOLEAN
NIL
|;
(Defun vlxls-app-kill (SaveYN / ExlObj)

  (while (setq ExlObj (vlax-get-object "Excel.Application"))

    (vlxls-app-quit ExlObj SaveYN)

  )

)
;|
Examples:

(vlxls-app-kill T) è nil




Excel Application Session Progress Function

Name
(vlxls-app-autofit ExcelSessionVLA-OBJECT)

Usage
Autofit the column width of all Excel session used ranges.

Input
VLOBJ
Excel session vla-object

RetVal
True
Variant
T

Fail
BOOLEAN
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*) è T

(vlxls-app-autofit *xlapp*) è NIL




Excel Sheet Progress Function

Name
(vlxls-sheet-get-all ExcelSessionVLA-OBJECT)

Usage
Get name list of all sheets.

Input
VLOBJ
Excel session vla-object

RetVal
True
LIST
List contain all sheets’ name

Fail
BOOLEAN
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*) è ("Sheet1" "Sheet2" "Sheet3")




Excel Sheet Progress Function

Name
(vlxls-sheet-get-active ExcelSessionVLA-OBJECT)

Usage
Get active sheet name.

Input
VLOBJ
Excel session vla-object

RetVal
True
STRING
Active sheet's name string

Fail
BOOLEAN
NIL
|;
(Defun vlxls-Sheet-Get-Active (xlapp)

  (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'name)

)
;|
Examples:

(vlxls-sheet-get-active *xlapp*) è "Sheet2"




Excel Sheet Progress Function

Name
(vlxls-sheet-delete ExcelSessionVLA-OBJECT DeleteSheetName)

Usage
Delete certain sheet by name.

Input
VLOBJ
Excel session vla-object


STRING
Sheet name to delete

RetVal
True
BOOLEAN
T

Fail
BOOLEAN
NIL
|;
(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”) è T

(vlxls-sheet-delete *xlapp* “UnExistingSheet”) è NIL




Excel Sheet Progress Function

Name
(vlxls-sheet-rename NewSheetName OldSheetName ExcelSessionVLA-OBJECT)

Usage
Rename certain sheet by name.

Input
STRING
New sheet name string

STRING
Old sheet name string

VLOBJ
Excel session vla-object

RetVal
True
BOOLEAN
T

Fail
BOOLEAN
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*) è T

(vlxls-sheet-rename “New” NIL *xlapp*) è T

(vlxls-sheet-rename “Sheet3” NIL *xlapp*) è NIL

(vlxls-sheet-rename “Sheet2” “Sheet1” *xlapp*) è NIL

(vlxls-sheet-rename “Sheet2” “UnExistSheet” *xlapp*) è NIL




Excel Sheet Progress Function

Name
(vlxls-sheet-add ExcelSessionVLA-OBJECT NewSheetName)

Usage
New sheet name. If sheet name exist, return NIL

Input
VLOBJ
Excel session vla-object

STRING
New added sheet name string

RetVal
True
BOOLEAN
T

Fail
BOOLEAN
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”) èT

(vlxls-sheet-add *xlapp* NIL) èT

(vlxls-sheet-add *xlapp* “NewSheet”) è NIL




Excel Sheet Progress Function

Name
(vlxls-sheet-put-active ExcelSessionVLA-OBJECT ActiveSheetName)

Usage
Put certain sheet as active sheet. If sheet name not exist, create automatically.

Input
VLOBJ
Excel session vla-object

STRING
New active sheet name string

RetVal
True
BOOLEAN
T

Fail
BOOLEAN
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”) è T

(vlxls-sheet-put-active *xlapp* “NewSheet”) è T




Excel Sheet Progress Function

Name
(vlxls-sheet-get-usedrange ExcelSessionVLA-OBJECT SheetName)

Usage
Get all used range of certain Excel sheet. If sheet name not exist, return NIL.

Input
VLOBJ
Excel session vla-object

STRING
Excel sheet name string, NIL for current active sheet.

RetVal
True
VLOBJ
Excel Range vla-object

Fail
BOOLEAN
NIL
|;
(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”) è T

(vlxls-sheet- get-usedrange *xlapp* “NewSheet”) è T




Excel Cell and Range Progress Function

Name
(vlxls-cellid CellIDStringOrList)

Usage
Divide complex Excel Cell ID into a two-string-item list, contain the Left-Upper and Right-Lower Cell ID.
If only one Cell ID is provided, set the Right-Lower Cell ID to “”.

Input
STR/LIST
Complex Excel Cell ID string or simple Cell ID string/list.

RetVal
True
LIST
List of Left-Upper and Right-Lower Cell ID

Fail
BOOLEAN
NIL
|;
(Defun vlxls-cellid (id / xx id1 id2 Rtn)

  (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)) è ("C14" "")

(vlxls-cellid “D23”) è ("D23" "")

(vlxls-cellid “C12:F3”) è ("C3" "F12")

(vlxls-cellid “F15:G22”) è ("F15" "G22")




Excel Cell and Range Progress Function

Name
(vlxls-rangeid CellIDStringOrList)

Usage
VLXLS treats Excel Cell ID in two types: AutoCAD LIST and Excel simple Cell ID String. This function is used to convert Cell ID between the two types.

Input
STR/LIST
The Cell ID list or string

RetVal
True
STR/LIST
Cell ID value in another VLXLS ID type

Fail
BOOLEAN
NIL
|;
(Defun vlxls-rangeid (id / str->list list->str xid->str Rtn)

  (Defun str->list (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->str (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->list id)))

       ((= (type id) 'list) (setq Rtn (list->str id)))

  )

  Rtn

)
;|
Examples:

(vlxls-rangeid ‘(3 14)) è "C14"

(vlxls-rangeid “D23”) è (4 23)

(vlxls-rangeid “DD23”) è (108 23)




Excel Cell and Range Progress Function

Name
(vlxls-range-autofit RangeVLA_OBJECT)

Usage
Autofit the column width of a certain range object.

Input
VLOBJ
The Excel Range vla-object

RetVal
True
BOOLEAN
T

Fail
BOOLEAN
NIL
|;
(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”)) è T

(vlxls-range-autofit RangeObject) è NIL




Excel Cell and Range Progress Function

Name
(vlxls-cell-put-active ExcelSessionVLA-OBJECT CellIDStringOrList)

Usage
Select to certain Cell ID and activate it.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
VLOBJ
Active Range vla-object

Fail
BOOLEAN
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”) è #<VLA-OBJECT Range 09d1998c>

(vlxls-cell-put-active *xlapp* “F12”) è #<VLA-OBJECT Range 06c389a2>




Excel Cell and Range Progress Function

Name
(vlxls-cell-get-value ExcelSessionVLA-OBJECT CellIDStringOrList)

Usage
Get value of certain Cell ID.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
STR/LIST
String for one cell, a 2 dimension list for multiple cells or merged cell

Fail
BOOLEAN
NIL
|;
(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”) è “g”

(vlxls-cell-get-value *xlapp* “C12:C12”) è “g”

(vlxls-cell-get-value *xlapp* “C12:C15”) è (("g") ("") ("") (""))

(vlxls-cell-get-value *xlapp* “C12:F12”) è (("g" "ds" "" ""))

(vlxls-cell-get-value *xlapp* “C12:F15”) è (("g" "ds" "" "") ("" "" "g" "") ("" "" "" "") ("" "" "" ""))




Excel Cell and Range Progress Function

Name
(vlxls-cell-put-value ExcelSessionVLA-OBJECT CellIDStringOrList DataList)

Usage
Pass a 1 dimension or a 2 dimension string list into Excel, started at certain Cell ID.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The start Cell ID [Left-Upper] list or string

STR/LIST
If this argument is a string, VLXLS will fill same string to all cells.

Or the argument should be a 1 dimension list or a 2 dimension list to fill in Excel. If the data list can NOT match the
given cell ID, VLXLS will only fill first cell, fill to other cells will be ignored.

RetVal
True
VLOBJ
All Excel Range vla-object that just be filled in by given data list

Fail
BOOLEAN
NIL
|;
(Defun vlxls-cell-put-value

       (xl id Data / vllist-explode idx xx yy ary Rtn)

    (Defun vllist-explode  (lst)

        (cond

            ((not lst) nil)

            ((atom lst) (list lst))

            ((append (vllist-explode (car lst))

                     (vllist-explode (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-explode 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”) è #<VLA-OBJECT Range 093a7764>

(vlxls-cell-put-value *xlapp* “C12:F3” “xx”) è #<VLA-OBJECT Range 43c5ac64>

(vlxls-cell-put-value *xlapp* “C12:D13” ‘((“zz” “xx”)(“xx” “zz”))) è #<VLA-OBJECT Range 1b8f2a64>




Excel Cell and Range Progress Function

Name
(vlxls-cellid-calc BaseCellId XOffset YOffset)

Usage
Calculate a new Cell ID for given delta X and Y from base Cell ID.

Input
STR/LIST
Base Cell ID string or list

INT
X offset integer of Cell ID

INT
Y offset integer of Cell ID

RetVal
True
STRING
An Excel Complex Cell ID format contain the base Cell ID and target Cell ID.

Fail
BOOLEAN
NIL
|;
(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) è "C12:E32"

(vlxls-cellid-calc ‘(2 23) 2 -120) è "B1:D23"




Excel Cell and Range Progress Function

Name
(vlxls-get-row-value ExcelSessionVLA-OBJECT StartCellIDStringOrList RowCellNumber)

Usage
Get values of certain row.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Start Cell ID list or string

INT
Number of cells in row to read.

RetVal
True
LIST
A list contain cells' value in row

Fail
BOOLEAN
NIL
|;
(Defun vlxls-get-row-value (xl id len / vllist-explode Rtn)

  (Defun vllist-explode       (lst)

    (cond

      ((not lst) nil)

      ((atom lst) (list lst))

      ((append (vllist-explode (car lst))

              (vllist-explode (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-explode (vlxls-cell-get-value xl id)))

  Rtn

)
;|
Examples:

(vlxls-get-row-value *xlapp* “C12” 2) è ("zz" "xxx")

(vlxls-get-row-value *xlapp* “C12” -20) è ("" "" "zz")




Excel Cell and Range Progress Function

Name
(vlxls-put-row-value ExcelSessionVLA-OBJECT StartCellIDStringOrList StringList)

Usage
Put a string list into Excel row started by certain cell.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Start Cell ID list or string

STR/LIST
A string to fill in one cell or a 1 dimension string list to fill in row cells.

RetVal
True
VLOBJ
Filled Excel Range vla-object

Fail
BOOLEAN
NIL
|;
(Defun vlxls-put-row-value (xl id data / Rtn)

  (if (= (type data) 'str)

    (setq data (list data))

  )

  (setq   id (car (vlxls-cellid id))

       id (vlxls-cellid-calc id (1- (length data)) 0)

  )
;;;不允许自动调整大小
  ;(vlxls-range-autofit

    (setq Rtn (vlxls-cell-put-value xl id (list data)))

  ;)

  Rtn

)
;|
Examples:

(vlxls-put-row-value *xlapp* “C12” “abc”) è#<VLA-OBJECT Range 2a621cac>

(vlxls-put-row-value *xlapp* ‘(12 3) “abc”) è#<VLA-OBJECT Range 7a36c491>

(vlxls-put-row-value *xlapp* “C12” ‘("zz" "xxx")) è#<VLA-OBJECT Range 09d1da1c>

(vlxls-put-row-value *xlapp* ‘(12 3) ‘("zz" "xxx")) è#<VLA-OBJECT Range 0a26c4f3>




Excel Cell and Range Progress Function

Name
(vlxls-get-column-value ExcelSessionVLA-OBJECT StartCellIDStringOrList ColumnCellNumber)

Usage
Get values of certain column.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Start Cell ID list or string

INT
Number of cells in column to read.

RetVal
True
LIST
A list contain cells' value in column

Fail
BOOLEAN
NIL
|;
(Defun vlxls-get-column-value (xl id len / vllist-explode Rtn)

  (Defun vllist-explode       (lst)

    (cond

      ((not lst) nil)

      ((atom lst) (list lst))

      ((append (vllist-explode (car lst))

              (vllist-explode (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-explode (vlxls-cell-get-value xl id)))

  Rtn

)
;|
Examples:

(vlxls-get-column-value *xlapp* “C12” 2) è ("zz" "sdfsdf")

(vlxls-get-column-value *xlapp* “C12” -20) è ("" "" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "zz")




Excel Cell and Range Progress Function

Name
(vlxls-put-column-value ExcelSessionVLA-OBJECT StartCellIDStringOrList StringList)

Usage
Put a string list into Excel column started by certain cell.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Start Cell ID list or string

STR/LIST
A string to fill in one cell or a 1 dimension string list to fill in column cells.

RetVal
True
VLOBJ
Filled Excel Range vla-object

Fail
BOOLEAN
NIL
|;
(Defun vlxls-put-column-value (xl id data / item Rtn)

  (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))

  )
;;;不允许自动调整表格大小
  ;(vlxls-range-autofit

    (setq Rtn (vlxls-cell-put-value xl id (reverse Rtn)))

  ;)

  Rtn

)
;|
Examples:

(vlxls-put-column-value *xlapp* “C12” “abc”) è#<VLA-OBJECT Range 049c521b>

(vlxls-put-column-value *xlapp* ‘(12 3) “abc”) è#<VLA-OBJECT Range 0235cba1>

(vlxls-put-column-value *xlapp* “C12” ‘("zz" "xxx")) è#<VLA-OBJECT Range 09d1da1c>

(vlxls-put-column-value *xlapp* ‘(12 3) ‘("zz" "xxx")) è#<VLA-OBJECT Range 0a26c4f3>




Excel Cell and Range Progress Function

Name
(vlxls-cell-get-aci ExcelSessionVLA-OBJECT CellIDStringOrList)

Usage
Get the background color (In AutoCAD ColorIndex mode) of certain Excel cell, Multiple color will return 256.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
INT
Valid ACI Integer number (0 to 256)

Fail
BOOLEAN
NIL
|;
(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”) è256

(vlxls-cell-get-aci *xlapp* ‘(12 3)) è15




Excel Cell and Range Progress Function

Name
(vlxls-cell-put-aci ExcelSessionVLA-OBJECT CellIDStringOrList ACINumber)

Usage
Put or clear the background color (In AutoCAD ColorIndex mode) of certain Excel cells.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

INT
ACI Integer number, NIL for remove background color

RetVal
True
VLOBJ
Modified Excel Range vla-object

Fail
BOOLEAN
NIL
|;
(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) è#<VLA-OBJECT Range 09d1369c>

(vlxls-cell-put-aci *xlapp* “C12” nil) è#<VLA-OBJECT Range 09d1369c>




Excel Cell and Range Progress Function

Name
(vlxls-text-get-aci ExcelSessionVLA-OBJECT CellIDStringOrList)

Usage
Get the text color (In AutoCAD ColorIndex mode) of certain Excel cells.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
INT
Valid ACI Integer number (0 to 256)

Fail
BOOLEAN
NIL
|;
(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”) è256

(vlxls-text-get-aci *xlapp* ‘(12 3)) è15




Excel Cell and Range Progress Function

Name
(vlxls-text-put-aci ExcelSessionVLA-OBJECT CellIDStringOrList ACINumber)

Usage
Put or clear the content color (In AutoCAD ColorIndex mode) of certain Excel cells.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

INT
ACI Integer number, NIL for remove background color

RetVal
True
VLOBJ
Modified Excel Range vla-object

Fail
BOOLEAN
NIL
|;
(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) è#<VLA-OBJECT Range 09d1369c>

(vlxls-text-put-aci *xlapp* “C12” nil) è#<VLA-OBJECT Range 09d1369c>




Excel Cell and Range Progress Function

Name
(vlxls-text-get-prop ExcelSessionVLA-OBJECT CellIDStringOrList)

Usage
Get the properties of content of certain Excel cells. Multiple cells will only record the Left-Upper cell.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
LIST
A dot-paired list contain text properties. Syntax is as following:

((0 . LeftUpperCellID)(7 . FontStyle) (62 . TextACIColor) (72 . TextAlignment) (420 . TextTrueColor))

FontStyle will be recorded as Windows TTF font name displayed in Excel

VLXLS only support horizontal for TextAlignment: 9=Left, 10=Center, 11=Right

Fail
BOOLEAN
NIL
|;
(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”) è((0 . "C12") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 9) (420 . 16711935))

(vlxls-text-get-prop *xlapp* ‘(2 10)) è((0 . "B10") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 11) (420 . 16711935))




Excel Cell and Range Progress Function

Name
(vlxls-cell-get-prop ExcelSessionVLA-OBJECT CellIDString)

Usage
Get the properties of certain Excel cells.

Input
VLOBJ
The Excel Session vla-object

STR
The Cell ID string

RetVal
True
LIST
A dot-paired list contain cell properties. Syntax is as following:

((0 . CellIDString)(1 . CellValueList) (10 . LeftUpperLocation_of_LeftUpperCell) (41 . TotalColumnWidth)
(42 . TotalRowHeight) (-1 . ReturnValue_of_vlxls-text-get-prop))

If only one cell, CellValueList can be a string, or it will be a 2 dimension list.

LeftUpperLocation_of_LeftUpperCell is in Excel units and Cell “A1” will be original.

TotalRowHeight and TotalColumnWidth are both in Excel units

Fail
BOOLEAN
NIL
|;
(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”) è((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”) è((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)))




Excel Cell and Range Progress Function

Name
(vlxls-cell-border ExcelSessionVLA-OBJECT CellIDString)

Usage
Force to draw or hide 4 slim border to certain Excel cells.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

BOOLEAN
Flag to draw border line or NOT, T for draw, NIL for disable

RetVal
True
BOOLEAN
NIL

Fail
BOOLEAN
NIL
|;
(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) èNIL

(vlxls-cell-border *xlapp* “B8” NIL) èNIL




Excel Cell and Range Progress Function

Name
(vlxls-cell-merge ExcelSessionVLA-OBJECT CellIDString)

Usage
Run cell merge in Excel. Only 1st un-empty value will be left in merged cell.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
VLOBJ
New merged cell range vla-object

Fail
BOOLEAN
NIL
|;
(Defun vlxls-cell-merge      (xl id / vllist-explode Val Rtn)

  (Defun vllist-explode       (lst)

    (cond

      ((not lst) nil)

      ((atom lst) (list lst))

      ((append (vllist-explode (car lst))

              (vllist-explode (cdr lst))

       )

      )

    )

  )

  (setq val (vllist-explode (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”) è#<VLA-OBJECT Range 0023ab7c>




Excel Cell and Range Progress Function

Name
(vlxls-cell-unmerge ExcelSessionVLA-OBJECT CellIDString)

Usage
Run cell unmerge in Excel. merged value will be placed into the left upper cell, others will be empty.

If given Cell ID is not a valid merged cell, return NIL

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
VLOBJ
All unmerged cells range vla-object

Fail
BOOLEAN
NIL
|;
(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”) è#<VLA-OBJECT Range 0023ab7c>

(vlxls-cell-unmerge *xlapp* “E14”) è#<VLA-OBJECT Range 09ce72e4>




Excel Cell and Range Progress Function

Name
(vlxls-cell-merge-p ExcelSessionVLA-OBJECT CellIDString)

Usage
Check if the certain Excel cell is merged

Input
VLOBJ
The Excel Session vla-object

STR/LIST
The Cell ID list or string

RetVal
True
BOOLEAN
T

Fail
BOOLEAN
NIL
|;
(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”) èT

(vlxls-cell-merge-p *xlapp* “E14”) èNIL




Excel Cell and Range Progress Function

Name
(vlxls-cell-get-mergeid ExcelSessionVLA-OBJECT CellIDString)

Usage
Get the Left-Upper and Right-Lower Cell ID of a merged cell.

Input
VLOBJ
The Excel Session vla-object

STR/LIST
Any Cell ID list or string of a merged cell

RetVal
True
STRING
A string contain Left-Upper and Right-Lower cells’ ID

Fail
BOOLEAN
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”) è”B9:G19”

(vlxls-cell-get-mergeid *xlapp* “E14”) è”A11:G19”




Excel Cell and Range Progress Function

Name
(vlxls-range-getid RangeObject)

Usage
Get the Left-Upper and Right-Lower Cell ID of a range object.

Input
VLOBJ
The Excel Range vla-object

RetVal
True
STRING
A string contain Left-Upper and Right-Lower cells’ ID

Fail
BOOLEAN
NIL
|;
(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) è”C12:G19”

(vlxls-range-getid RangeObject) è”B16:B16”




Excel Cell and Range Progress Function

Name
(vlxls-range-size RangeObject)

Usage
Get the column width and row height list of a range object.

Input
VLOBJ
The Excel Range vla-object

RetVal
True
STRING
A list contain two sub-list, each sub-list contain real number of columns' width and rows' height. Syuntax:

((Column1Width Column2Width…)(Row1Height Row2Height…))

Fail
BOOLEAN
NIL
|;
(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) è ((27.0 27.0 110.25 51.0 69.75) (14.25 14.25 14.25 14.25 14.25 57.0 14.25))




Excel Cell and Range Progress Function

Name
(vlxls-rangevalue->safearray RangeValueList)

Usage
Convert a Range-Value-List into safearray list so that they can be passed into Excel directly.

VLXLS defined a Range-Value-List as a dot-paired list contain two elements: 1st for Cell ID, 2nd for the cell content. Example for Range-Value-List may be ‘(("A1" . "aaa")("A2" . "SDA")...("C12" . "ccc"))

Because Range-Value-List may NOT cover all Cell IDs, this function will automatically fill the undefined cells with "" so that the return variant can be send to Excel directly.

Input
VLOBJ
The Excel Range vla-object

RetVal
True
STRING
A safearray variant contain all given Range-Value-List

Fail
BOOLEAN
NIL
|;
(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->List (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_GetXY (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_GetMinMaxID (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->List ID))

      (setq IDN (list ID))

    )

    (foreach ID    IDN

      (setq MinID (XSub_GetMinMaxID ID MinID nil)

           MaxID (XSub_GetMinMaxID 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->List ID))

      (setq IDN (list ID))

    )

    (foreach ID    IDN

      (setq XY (XSub_GetXY 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”))) è#<safearray...>

(vlxls-variant->list (vlxls-rangevalue->safearray '(("A1" . "aaa")("B4" . "ccc"))))è(("aaa" "") ("" "") ("" "") ("" "ccc"))




Public Function

Name
(vlxls-get-property TopVLAObject NestPropertyString)

Usage
Get the property of a nested VLA-Object from the main top vla-object. Use same property indicator as VBA.

Input
VLOBJ
The Top vla-object

STRING
The Property combination string, divided with “.”, ordered from top to inner.

RetVal
True
ANY
The value of the most nested property.

Fail
BOOLEAN
NIL
|;
(Defun vlxls-get-property (top prop / vlstring->list item Rtn)

  (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”) è”Sheet1”

(vlxls-get-property RangeObject “MergeArea.Columns.Count”) è3




Following is the pre-define part of VLXLS project, VLXLS need a global variable named as *xls-color* to contain all color matching list. Syntax as (ECI ACI TrueColor), sorted as ECI number.

As VLXLS support two languages: English as international and Simplified Chinese as local. In Default, VLXLS will go to seek if global variable *Chinese* is true, if so, VLXLS will prompt Chinese, or VLXLS will display English as default.
|;
(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.2.50331"

)

;|(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


;;;页面设置
;;;(vlxls-Excel-Pagesetup *xlApp* ".LeftFooter" "&P")
;;;具体设置参考如下
;|
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell  插入分页符
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$3"  工作表顶端标题行
        .PrintTitleColumns = ""    工作表左端标题列
    End With
    ActiveSheet.PageSetup.PrintArea = "$C$1:$H$255"   工作表打印区域
    With ActiveSheet.PageSetup
        .LeftHeader = ""    左页眉
        .CenterHeader = ""  中页眉
        .RightHeader = ""   右页眉
        .LeftFooter = "&P"  左页脚
        .CenterFooter = "&N" 中页脚
        .RightFooter = "aaaaaaaaa"  右页脚
        .LeftMargin = Application.InchesToPoints(0.62)   左边距
        .RightMargin = Application.InchesToPoints(0.748031496062992) 右边距
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)   
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic  打印起始页
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
End Sub
|;
(defun vlxls-Excel-Pagesetup (xlapp Key var / sheet PageSetup)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq PageSetup (vlax-get-property sheet "PageSetup"))
  (vlax-put-property PageSetup Key var)
  )

;;; ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
;;;在单元格ID 之前插入分页符
(defun vlxls-Excel-InsertHPageBreaks (xlapp id / sheet HPageBreaks HPageBreaks)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq HPageBreaks (vlax-get-property sheet "HPageBreaks"))
  (vlxls-cell-put-active xlapp id)
  (vlax-invoke-method HPageBreaks 'Add (vlax-get-property xlapp "Activecell"))
  )

jx2008

没有住程序，怎么执行？

WXZDM562100

这种问题经常遇到，我的机器是win98的，到别人的xp上打开文件字体就成了？号，总是要style一次修改，楼主这主意太好了，顶死你