XLS to List

Free-Lancer

1. ;;fl ---  Xls Filename
   
2. ;;mod ---- t Only Read Sheet1
   
3. ;;         nil Read All sheet
   
4. (defun xls->list (fl mod / _readsheet excel wks shts sht sh tf)
   
5.   (defun _readsheet (sh / uc mR mC cells r c lst l)
   
6.     (setq uc        (vlax-get sh 'UsedRange)
   
7.           mR        (vlax-get (vlax-get uc 'Rows) 'Count)
   
8.           mC        (vlax-get (vlax-get uc 'Columns) 'Count)
   
9.           cells        (vlax-get sh 'Cells) ;_ActiveSheet Cells
   
10.           r        1 ;_Rows 计数
    
11.           c        1 ;_列计数
    
12.     )
    
13.     (repeat mC ;_列数
    
14.       (setq r 1)
    
15.       (repeat mR ;_行数
    
16.         (setq Lst (cons        (vlax-get (variant-value
    
17.                                     (vlax-get-property
    
18.                                       cells
    
19.                                       'item
    
20.                                       r
    
21.                                       c
    
22.                                     )
    
23.                                   )
    
24.                                   'text
    
25.                         )
    
26.                         lst
    
27.                   )
    
28.               r          (1+ r)
    
29.         )
    
30.       )
    
31.       (setq l        (cons lst l)
    
32.             lst        nil
    
33.       )
    
34.       (setq c (1+ c))
    
35.     )
    
36.     (reverse (mapcar 'reverse l)) ;_按列形成的表   
    
37.   )
    
38.   (if (and (setq excel (vlax-get-or-create-object "Excel.Application")) ;_ Excel ActiveX
    
39.            (findfile fl)
    
40.       )
    
41.     (progn
    
42.       (setq wks         (vlax-get excel 'workbooks) ;_ Workbooks
    
43.             shts (vlax-invoke wks 'open fl) ;_ Open Excel file , also can use Excel Findfile property
    
44.             sht         (vlax-get excel 'sheets)
    
45.             tf (vlax-get  excel 'Visible)
    
46.       )
    
47.       (if mod
    
48.         (setq l (_readsheet (vlax-get-property sht 'Item "Sheet1")))
    
49.         (progn
    
50.           (vlax-for sh sht
    
51.             (setq l (cons (_readsheet sh) l))
    
52.           )
    
53.           (setq l (reverse l))
    
54.         )
    
55.       )
    
56.       (if (zerop tf)
    
57.         (progn
    
58.           (vlax-invoke-method excel "Quit") ;_closed excel
    
59.           (if (vlax-object-released-p excel)
    
60.             (vlax-release-object excel) ;_this can not close excel
    
61.           )
    
62.         )
    
63.         (vlax-invoke-method sht "Close");_?
    
64.       )
    
65.       l
    
66.     )
    
67.   )
    
68. )

;;fl ---  Xls Filename<br /> ;;mod ---- t Only Read Sheet1<br /> ;;         nil Read All sheet<br /> (defun xls->list (fl mod / _readsheet excel wks shts sht sh tf)<br />   (defun _readsheet (sh / uc mR mC cells r c lst l)<br />     (setq uc        (vlax-get sh 'UsedRange)<br />           mR        (vlax-get (vlax-get uc 'Rows) 'Count)<br />           mC        (vlax-get (vlax-get uc 'Columns) 'Count)<br />           cells        (vlax-get sh 'Cells) ;_ActiveSheet Cells<br />           r        1 ;_Rows 计数<br />           c        1 ;_列计数<br />     )<br />     (repeat mC ;_列数<br />       (setq r 1)<br />       (repeat mR ;_行数<br />         (setq Lst (cons        (vlax-get (variant-value<br />                                     (vlax-get-property<br />                                       cells<br />                                       'item<br />                                       r<br />                                       c<br />                                     )<br />                                   )<br />                                   'text<br />                         )<br />                         lst<br />                   )<br />               r          (1+ r)<br />         )<br />       )<br />       (setq l        (cons lst l)<br />             lst        nil<br />       )<br />       (setq c (1+ c))<br />     )<br />     (reverse (mapcar 'reverse l)) ;_按列形成的表    <br />   )<br />   (if (and (setq excel (vlax-get-or-create-object "Excel.Application")) ;_ Excel ActiveX<br />            (findfile fl)<br />       )<br />     (progn<br />       (setq wks         (vlax-get excel 'workbooks) ;_ Workbooks<br />             shts (vlax-invoke wks 'open fl) ;_ Open Excel file , also can use Excel Findfile property<br />             sht         (vlax-get excel 'sheets)<br />             tf (vlax-get  excel 'Visible)<br />       )<br />       (if mod<br />         (setq l (_readsheet (vlax-get-property sht 'Item "Sheet1")))<br />         (progn<br />           (vlax-for sh sht<br />             (setq l (cons (_readsheet sh) l))<br />           )<br />           (setq l (reverse l))<br />         )<br />       )<br />       (if (zerop tf)<br />         (progn<br />           (vlax-invoke-method excel "Quit") ;_closed excel<br />           (if (vlax-object-released-p excel)<br />             (vlax-release-object excel) ;_this can not close excel <br />           )<br />         )<br />         (vlax-invoke-method sht "Close");_?<br />       )<br />       l<br />     )<br />   )<br /> )

scnjlwb

谢谢分享！