以前收集的函数，不是原创，共享出来方便大家

jun353835273

以前收集的excel函数，非原创，时间久了也不能明确出处，共享出来方便大家。
(defun TBxloadTypeLib        (/ tmp Key value filename do)
  (if msxl-xl24HourClock
    (setq do T)
    (progn (if (setq Key   "HKEY_CLASSES_ROOT\\Excel.Application\\CurVer"
                     value (vl-registry-read Key "")
               )
             (if (setq tmp   (strcat (substr value 19) ".0")
                       Key   (strcat
                               "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Office\\"
                               tmp
                               "\\Excel\\InstallRoot"
                             )
                       value (vl-registry-read Key "ath")
                 )
               (setq filename (strcat value "Excel.exe"))
             )
           )
           (if filename
             (progn (vlax-import-type-library
                      :tlb-filename         filename
                      :methods-prefix         "msxl-"
                      :properties-prefix "msxl-"
                      :constants-prefix         "msxl-"
                     )
                    (if        msxl-xl24HourClock
                      (setq do T)
                      (princ "\n加载Excel类型库失败")
                    )
             )
             (princ "\n未找到Excel类型库")
           )
    )
  )
  do
)

  ;取得当前打开的EXCEL应用程序
(defun TBxl:GetApp ()
  (gc)
  (vlax-get-object "Excel.Application")
)

  ;新建的EXCEL工作簿，并指定显示状态
(defun TBxl:OpenApp (mode / app) ;1-SHOW,0-HIDE
  (gc)
  (if (setq app (vlax-get-or-create-object "Excel.Application"))
    (progn (vlax-invoke-method
             (vlax-get-property app 'WorkBooks)
             'Add
           )
           (vla-put-visible app mode)
    )
  )
  app
)

  ;取得当前激活的工作表
(defun TBxl:GetAcSheet (app)
  (msxl-Get-ActiveSheet app)
)

  ;当前激活的工作表宽度自动适应
(defun TBxl:AutoFit (app)
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property
        (vlax-get-property (TBxl:GetAcSheet app) 'UsedRange)
        'Cells
      )
      'Columns
    )
    'AutoFit
  )
)

  ;从当前激活的工作表读取一行中指定数量的单元格
(defun TBxl:ReadRow (app r c n / value lst)
  (repeat n
    (setq value        (TBxl:GetCell app r c)
          lst        (append lst (list value))
          c        (1+ c)
    )
  )
  lst
)

  ;在当前激活的工作表写入一行
(defun TBxl:WriteRow (app r c values / value)
  (foreach value values
    (TBxl:SetCell app r c value)
    (setq c (1+ c))
  )
)

  ;读取指定单元格的内容
(defun TBxl:GetCell (app r c)
  (vlax-variant-value (msxl-get-value2 (TBxl:CELL app r c)))
)

  ;写入内容到指定单元格
(defun TBxl:SetCell (app r c value)
  (msxl-put-value2 (TBxl:CELL app r c) value)
)

  ;返回指定单元格对象
(defun TBxl:CELL (app r c)
  (vlax-variant-value
    (msxl-get-item
      (msxl-get-cells app)
      (vlax-make-variant r)
      (vlax-make-variant c)
    )
  )
)

  ;返回当前的第一次选中的区域的相关参数
(defun TBxl:GetSelection (app / Col tmp range r rn c cn)
  (defun Col (x / n y z ch)
    (setq n  26
          x  (1- x)
          y  (fix (/ x n))
          z  (- x (* y n))
          ch (chr (+ 65 z))
    )
    (if        (< 0 y)
      (strcat (Col y) ch)
      ch
    )
  )

  (setq        range (msxl-get-selection app)
        tmp   (msxl-get-rows range)
        r     (msxl-get-row tmp)
        rn    (msxl-get-count tmp)
        tmp   (msxl-get-columns range)
        c     (msxl-get-column tmp)
        cn    (msxl-get-count tmp)
        tmp   (strcat (Col c)
                      (itoa r)
                      ":"
                      (Col (+ c cn -1))
                      (itoa (+ r rn -1))
              )
        range   (msxl-get-range app tmp)
  )
  (msxl-select range)
  (list range r c rn cn)
)
;;;;;1、读取单个单元格excel数据函数
(defun Ljx-read-excel-data1 (vv hor sh) ;;;vv为列数直接输入字母、hor为 第几行，直接输入数字,sh为工作表对象sheet
  (vlax-variant-value (vlax-get-property (vlax-get-property sh 'Range (strcat vv (itoa hor))) 'Value2))
)

;;;;;2、读取单个单元格excel数据函数输出text格式
(defun Ljx-read-excel-text1 (vv hor sh ) ;;;vv为列数直接输入字母、hor为 第几行，直接输入数字,sh为工作表对象sheet
  (vl-princ-to-string (vlax-variant-value (vlax-get-property (vlax-get-property sh 'Range (strcat vv (itoa hor))) 'Value2)))
)
;;;;;3、读取单元格数据，支持区域输入,sheet-工作表对象，rangeid-单元格地址如"A1"、"A2:B5"、"A1:A100"
(defun ljx-vlxls-get-range-value1 ( sheet rangeid / range value valuelist )
  (setq range (vlax-get-property sheet 'Range rangeid))
  (setq value (vlax-get-property range 'Value2))
  (cond
    ((= (vlax-variant-type value)  8204);;;为数组时，即为区域;
      (setq value (vlax-safearray->list(vlax-variant-value value))
            valuelist (mapcar '(lambda (x)  (mapcar 'vlax-variant-value x)) value)
      )
    )
    ( T;;;;为单个单元格;
      (setq valuelist (vlax-variant-value value))
    )
  );;;;cond
  valuelist
)

;;;;运行示例函数
(defun test1 ()
  (vl-load-com)
  (setq exname "d:\\ABC.xls")
  (setq *excel* vlax-get-or-create-object "excel.application"))
  (setq *xlapp* (vlax-invoke-method (vlax-get-property *excel* 'Workbooks) 'Open exname))
  (vla-put-visible *excel* 1)
  (setq *sheet* (vlax-get-property (vlax-get-property *xlapp* 'Worksheets) 'item "DEF"))
  (setq dat0 (Ljx-vlxls-get-range-value1 *sheet* "E5")
        dat1 (Ljx-vlxls-get-range-value1 *sheet* "E5:F5");;;;输出：((-25.10 "张三"))
        dat2 (Ljx-vlxls-get-range-value1 *sheet* "E5:E6");;;;输出：((-25.10)(26.85))
        dat3 (Ljx-vlxls-get-range-value1 *sheet* "E5:F6");;;;输出：((-25.10 "张三")(26.85 "李四"))
        dat4 (Ljx-read-excel-data1  "E" 5 *sheet*);;;;-->-25.10
        dat5 (Ljx-read-excel-text1  "E"  5  *sheet* );;;;-->"-25.10"
        dat6 (Ljx-read-excel-data1  "E"  6 *sheet* );;;;-->26.85
        dat7 (Ljx-read-excel-text1 "E"  6 *sheet*);;;;-->"26.85"
        dat8 (Ljx-read-excel-data1 "F"  5 *sheet*);;;;-->“张三”
        dat9 (Ljx-read-excel-text1 "F"  5 *sheet*);;;;-->“张三”
        dat10 (Ljx-read-excel-data1  "F"  6 *sheet* );;;;-->"李四"
        dat11 (Ljx-read-excel-text1  "F"  6 *sheet* );;;;-->"李四"
  )
  (vlax-invoke-method (vlax-get-property *excel* "ActiveWorkbook") 'Close 0)
  (vlax-invoke-method *excel* 'QUIT)
  (vlax-release-object *sheet*)
  (vlax-release-object *xlapp*)
)

jun353835273

swb4420 发表于 2020-4-1 17:33
也没说这个有什么作用

这个就像菜刀一样

iszc

谢谢分享           

vip-happy

好用好用，非常好用

感谢楼主分享程序

tianying307

感谢楼主分享程序

shh1980

感谢分享！

htlaser

感谢楼主分享程序

zjy2999

学习！！！！！

yoyoho

感谢楼主分享程序!!!!!!

烟盒迷唇

好用好用，非常好用

yaokui25

感谢楼主分享!!!!!!

409063431@qq.co

哒哒哒哒哒哒

xj6019

感谢楼主分享程序