找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 525|回复: 0

[LISP程序]:如何从execel表中获取数据?

[复制链接]
发表于 2006-1-2 16:07:23 | 显示全部楼层 |阅读模式

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

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

×
这个程序好像是明经通道里的程序,因为水平不够,下载后一直没敢看!这两天闲下来无聊,试着看了看!
原文是循序渐进式的教学,文章确实写的很好,不过在一个一个程序测试时感觉到了一点问题:
1、在函数1里(即加载Excel类型库时),原程序是搜索系统盘的Excel*.olb或Excel.exe文件(注意 Excel 2002 用的是可执行文件来身来代替在以往版本中所使用的分离的TLB或OLB文件),但我的电脑中execel装在d盘,只好在函数1中加入了"D:/OFFICE/Office10/EXCEL.EXE"路径,各位可将该部分更改为自己的execel路径后使用该程序。
2、这个不算程序的问题,只是我在主程里加入两个变量并赋值,见变量file1和xlapp。
结果运行后竟而通过了!现将更改后的程序贴上来,希望高手多多指点!
注:该程序仅按列顺序获得某一区域的值并返回嵌套的列表,如果需要行顺序获取,可参照原程序(见附件)!
[php];;;这个算主程吧
;;;*************************************************************************
;;; 模块: DSX-Excel-GetRangeValues-ByCols
;;; 描述: 按列顺序获得某一区域的值并返回嵌套的列表
;;; 参数: 起始行, 起始列, 行数, 列数
;;; 样例: (DSX-Excel-GetRangeValues-ByCols 1 1 5 10) 获取从 1A到 5J区域的值,每一子列表为一列
;;;*************************************************************************
(vl-load-com)
(defun DSX-Excel-GetRangeValues-ByCols (startrow   startcol
                                        numrows           numcols
                                        /           nextrow
                                        nextcol           collst
                                        outlst
                                       )
  (setq        file1 (getfiled        "请选择要获取数据的EXECEL文件"
                        ""
                        "xls"
                        4
              )
  )
  (setq xlapp (DSX-Open-Excel-Exist file1 "hide"))
  (if (DSX-Load-TypeLib-Excel)
    (progn
      (setq nextcol startcol)
      (repeat numcols
        (setq collst  (DSX-Excel-Get-ColumnValues nextcol startrow numrows)
              outlst  (if outlst
                        (append outlst (list collst))
                        (list collst)
                      )
              nextcol (1+ nextcol)
        )
      )
      (princ "\n列表为:")
      outlst
    )
    (princ "\n未加载EXECEL")
  )
)

;;;********************************************************************************;;;
;;;----------------------------函数1:加载Excel类型库-------------------------------;;;
;;;-----------函数1演示了怎样通过Excel不同版本来取得与其类型库相关联。-------------;;;
;;;注意 Excel 2002 用的是可执行文件来身来代替在以往版本中所使用的分离的TLB或OLB文件;;;
;;;********************************************************************************;;;
(defun DSX-TypeLib-Excel (/ sysdrv tlb)
  (setq sysdrv (getenv "systemdrive"))
  (cond
    ((setq
       tlb (findfile
             (strcat
               sysdrv
               "\\Program Files\\Microsoft Office\\Office\\Excel8.olb"
             )
           )
     )
     tlb
    )
    ((setq
       tlb (findfile
             (strcat
               sysdrv
               "\\Program Files\\Microsoft Office\\Office\\Excel9.olb"
             )
           )
     )
     tlb
    )
    ((setq tlb
            (findfile
              (strcat
                sysdrv
                "\\Program Files\\Microsoft Office\\Office\\Excel10.olb"
              )
            )
     )
     tlb
    )
    ((setq
       tlb (findfile
             "D:/OFFICE/Office10/EXCEL.EXE"
             ;;其余均为演示,这里稍做更改,因为我的EXECEL装在D:/OFFICE/Office10/目录下
           )
     )
     tlb
    )
    ((setq tlb
            (findfile
              (strcat
                sysdrv
                "\\Program Files\\Microsoft Office\\Office10\\Excel.exe"
              )
            )
     )
     tlb
    )
  )
)

;;;*************************************************************;;;
;;;-------------------函数2:定义类型库接口----------------------;;;
;;;示例2演示了一个简单的函数来加载类型库并判断是否成功返回T或nil;;;
;;;*************************************************************;;;
(defun DSX-Load-TypeLib-Excel (/ tlbfile tlbver out)
  (cond
    ((null msxl-xl24HourClock)
     (if (setq tlbfile (DSX-TypeLib-Excel))
       (progn
         (setq tlbver (substr (vl-filename-base tlbfile) 6))
         (cond
           ((= tlbver "9")
            (princ "\n初始化 Microsoft Excel 2000...")
           )
           ((= tlbver "8")
            (princ "\n初始化 Microsoft Excel 97...")
           )
           ((= (vl-filename-base tlbfile) "EXECL")
            (princ "\n初始化 Microsoft Excel XP...")
           )
         )
         (vlax-import-type-library
           :tlb-filename      tlbfile                 :methods-prefix
           "msxl-"              :properties-prefix "msxl-"
           :constants-prefix  "msxl-"
          )
         (if msxl-xl24HourClock
           (setq out T)
         )
       )
     )
    )
    (T (setq out T))
  )
  out
)

;;;***************************************************;;;
;;;-----函数3:打开Excel 并在其中打开现有的文档文件----;;;
;;; 注意: <xfile> 必须为全路径文件名------------------;;;
;;; <dmode> 可以设为 "SHOW" (显示)或 "HIDE" (隐藏),--;;;
;;; 它取决于你希望Excel 进程是否可以让用户直接操作访问;;;
;;;***************************************************;;;
(defun DSX-Open-Excel-Exist (xfile dmode / appsession)
  (princ "\n打开 Excel 电子表格文件...")
  (cond
    ((setq fn (findfile xfile))
     (cond
       ((setq appsession
               (vlax-get-or-create-object "Excel.Application")
        )
        (vlax-invoke-method
          (vlax-get-property appsession 'WorkBooks)
          'Open
          fn
        )
        (if (= (strcase dmode) "SHOW")
          (vla-put-visible appsession 1)
          (vla-put-visible appsession 0)
        )
       )
     )
    )
    (T (alert (strcat "\n不能找到指定的文件: " xfile)))
  )
  appsession
)

;;;**********************************************;;;
;;;-函数4:在活动的工作表中的单个单元格中获取数据-;;;
;;;获取行<relrow> 和列 <relcol>范围内的单元格对象;;;
;;;**********************************************;;;
(defun DSX-Excel-Get-Cell (rng relrow relcol)
  (vlax-variant-value
    (msxl-get-item
      (msxl-get-cells rng)
      (vlax-make-variant relrow)
      (vlax-make-variant relcol)
    )
  )
)

;;;**********************************;;;
;;;函数5:返回单元格(row, col)内容的值;;;
;;;---------此函数调用函数4----------;;;
;;;**********************************;;;
(defun DSX-Excel-Get-CellValue (row col)
  (vlax-variant-value
    (msxl-get-value
      (DSX-Excel-Get-Cell
        (msxl-get-ActiveSheet xlapp)
        row
        col
      )
    )
  )
)

;;;*****************************************************************;;;
;;;----------函数6:在活动的工作表中获取一定行范围中的数据-----------;;;
;;; 模块: DSX-Excel-Get-RowValues-----------------------------------;;;
;;; 描述: 返回给定行的单元格值列表----------------------------------;;;
;;; 参数: 行号(整数), 起始列, 单元格数量----------------------------;;;
;;; 样例: (DSX-Excel-Get-RowValues 3 1 20) 取得行3的前20个单元格的值;;;
;;;*****************************************************************;;;
(defun DSX-Excel-Get-RowValues
                               (row startcol numcells / next out)
  (setq next startcol)
  (repeat numcells
    (setq out
               (if out
                 (append out (list (DSX-Excel-Get-CellValue row next)))
                                        ; row x col
                 (list (DSX-Excel-Get-CellValue row next))
                                        ; row x col
               )
          next (1+ next)
    )
  )                                        ; repeat
  out
)

;;;********************************************************************;;;
;;;------------函数7:在活动的工作表中获取一定列范围中的数据------------;;;
;;; 模块: DSX-Excel-Get-ColumnValues-----------------------------------;;;
;;; 描述: 返回给定列的单元格值列表-------------------------------------;;;
;;; 参数: 列号(整数), 起始行, 单元格数量-------------------------------;;;
;;; 样例: (DSX-Excel-Get-ColumnValues 2 1 20) 取得列2的前20个单元格的值;;;
;;;********************************************************************;;;
(defun DSX-Excel-Get-ColumnValues (col startrow numcells / next out)
  (setq next startrow)
  (repeat numcells
    (setq out
               (if out
                 (append out (list (DSX-Excel-Get-CellValue next col)))
                 (list (DSX-Excel-Get-CellValue next col))
               )
          next (1+ next)
    )
  )                                        ; repeat
  out
)[/php]
详见附件原文!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-29 00:07 , Processed in 0.285648 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表