[转贴]：一个值得学习的VLISP与EXCEL之间连接及数据传输和函数集
一个值得学习的VLISP与EXCEL之间连接及数据传输和函数集;;;*************************************************************************;;;
;;; DSX-API-Excel.LSP ;;;
;;; Visual LISP ActiveX API for Excel 97, 2000 and XP ;;;
;;; Copyright (C)2002 David M. Stein, All rights reserved ;;;
;;;*************************************************************************;;;
;;; Version 2002.22 05/15/02: Initial release ;;;
;;;*************************************************************************;;;
;;; Code provided AS-IS without warranty of any kind given for any purpose;;;
;;; or use, either explicitly, implicitly or as a derivative work item. ;;;
;;; User assumes ANY AND ALL RISK and LIABILITY for use of any of this code ;;;
;;; for any consequential damages of any kind.These functions are defined ;;;
;;; within DSX Tools 2002.22 when loaded into AutoCAD.This document is ;;;
;;; provided for informational purposes only. ;;;
;;;*************************************************************************;;;
(vl-load-com)
;;;*************************************************************************
;;; MODULE: DSX-TypeLib-Excel
;;; DESCRIPTION: Returns typelib (olb) file for either Excel 97, 2000, or XP
;;; ARGS: none
;;; EXAMPLE: (DSX-TypeLib-Excel)
;;;*************************************************************************
(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 (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel.exe")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office10\\Excel.exe")))
tlb
)
)
)
;;;*************************************************************************
;;; MODULE: DSX-Load-TypeLib-Excel
;;; DESCRIPTION: Loads typelib for Excel 97, 2000 or XP (whichever is found)
;;; ARGS: none
;;; EXAMPLE: (DSX-Load-TypeLib-Excel)
;;;*************************************************************************
(defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out)
(dsx-princ "\n(DSX-Load-TypeLib-Excel)")
(cond
( (null msxl-xl24HourClock)
(if (setq tlbfile (DSX-TypeLib-Excel))
(progn
(setq tlbver (substr (vl-filename-base tlbfile) 6))
(cond
( (= tlbver "9")(princ "\nInitializing Microsoft Excel 2000...") )
( (= tlbver "8")(princ "\nInitializing Microsoft Excel 97...") )
( (= (vl-filename-base tlbfile) "Excel.exe")
(princ "\nInitializing 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
)
;;;*************************************************************************
;;; MODULE: DSX-Open-Excel-New
;;; DESCRIPTION: Opens a new session of Excel 97, 2000 or XP
;;; ARGS: display-mode ("SHOW" or "HIDE")
;;; EXAMPLE: (setq xlapp (DSX-Open-Excel-New "SHOW"))
;;;*************************************************************************
(defun DSX-Open-Excel-New (dmode / appsession)
(dsx-princ "\n(DSX-Open-Excel-New)")
(princ "\nCreating new Excel Spreadsheet file...")
(cond
( (setq appsession (vlax-create-object "Excel.Application"))
(vlax-invoke-method
(vlax-get-property appsession 'WorkBooks)
'Add
)
(if (= (strcase dmode) "SHOW")
(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
)
)
)
appsession
)
;;;*************************************************************************
;;; MODULE: DSX-Open-Excel-Exist
;;; DESCRIPTION: Gets handle to existing (running) session of Excel 97, 2000, XP
;;; ARGS: xls-filename, display-mode ("SHOW" or "HIDE")
;;; EXAMPLE: (setq xlapp (DSX-Open-Excel-Exist "myfile.xls" "SHOW"))
;;;*************************************************************************
(defun DSX-Open-Excel-Exist (xfile dmode / appsession)
(dsx-princ "\n(DSX-Open-Excel-Exist)")
(princ "\nOpening Excel Spreadsheet file...")
(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 "\nCannot locate source file: " xfile)) )
)
appsession
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-ColumnList
;;; DESCRIPTION: Write each list member to a column (startcol) starting at row (startrow)
;;; ARGS: list, startrow, startcol
;;; EXAMPLE: (DSX-Excel-Put-ColumnList '("A" "B" "C") 1 2) puts members into cells (1,B) (2,B) (3,B) respectively
;;;*************************************************************************
(defun DSX-Excel-Put-ColumnList (lst startrow startcol)
(dsx-princ "\n(DSX-Excel-Put-ColumnList)")
(foreach itm lst
(msxl-put-value
(DSX-Excel-Get-Cell range startrow startcol)
itm
)
(setq startrow (1+ startrow))
); repeat
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-RowList
;;; DESCRIPTION: Write each list member to row (startrow) starting at column (startcol)
;;; ARGS: list, startrow, startcol
;;; EXAMPLE: (DSX-Excel-Put-RowList '("A" "B" "C") 2 1) puts members into cells (1,B) (1,C) (1,D) respectively
;;;*************************************************************************
(defun DSX-Excel-Put-RowList (lst startrow startcol)
(dsx-princ "\n(DSX-Excel-Put-RowList)")
(foreach itm lst
(msxl-put-value
(DSX-Excel-Get-Cell range startrow startcol)
itm
)
(setq startcol (1+ startcol))
); repeat
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-CellColor
;;; DESCRIPTION: Applies fill-color to specified cell
;;; ARGS: row, column, color (integer)
;;; EXAMPLE: (DSX-Excel-Put-CellColor 1 1 14) apply color #14 to cell (1,A)
;;;*************************************************************************
(defun DSX-Excel-Put-CellColor (row col intcol / rng)
(setq rng (DSX-Excel-Get-Cell (msxl-get-ActiveSheet xlapp) row col))
(msxl-put-colorindex (msxl-get-interior rng) intcol)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-RowCellsColor
;;; DESCRIPTION: Applies fill-color to a row of cells
;;; ARGS: startrow, startcol, num-cols, color (integer)
;;; EXAMPLE: (DSX-Excel-Put-RowCellsColor 1 1 5 14) Start at row=1 col=1 repeat for 5 columns using color #14
;;;*************************************************************************
(defun DSX-Excel-Put-RowCellsColor
(startrow startcol cols intcol / next)
(dsx-princ "\n(DSX-Excel-Put-RowCellsColor)")
(setq next startcol)
(repeat cols
(DSX-Excel-Put-CellColor startrow next intcol)
(setq next (1+ next))
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-ColumnCellsColor
;;; DESCRIPTION: Change fill color in a column of cells
;;; ARGS: startrow, startcol, num-rows, color (integer)
;;; EXAMPLE: (DSX-Excel-Put-ColumnCellsColor 1 1 5 14) Start at row=1 col=1 repeat for 5 rows using color #14
;;;*************************************************************************
(defun DSX-Excel-Put-ColumnCellsColor
(startrow startcol rows intcol / next)
(dsx-princ "\n(DSX-Excel-Put-ColumnCellsColor)")
(setq next startrow)
(repeat rows
(DSX-Excel-Put-CellColor next startcol intcol)
(setq next (1+ next))
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-Cell
;;; DESCRIPTION: Get cell object relative to range using (relrow) and (relcol) offsets
;;; ARGS: range-object, relative-row, relative-col
;;; EXAMPLE: (DSX-Excel-Get-Cell rng1 2 2)
;;;*************************************************************************
(defun DSX-Excel-Get-Cell (rng relrow relcol)
(dsx-princ "\n(DSX-Excel-Get-Cell)")
(vlax-variant-value
(msxl-get-item (msxl-get-cells rng)
(vlax-make-variant relrow)
(vlax-make-variant relcol)
)
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-Cellvalue
;;; DESCRIPTION: Return value in given cell (row, column) of active session object (xlapp)
;;; ARGS: row(int), column(int)
;;; EXAMPLE: (DSX-Excel-Get-Cellvalue 1 2)
;;;*************************************************************************
(defun DSX-Excel-Get-Cellvalue (row col)
(dsx-princ "\n(DSX-Excel-Get-Cellvalue)")
(vlax-variant-value
(msxl-get-value
(DSX-Excel-Get-Cell
(msxl-get-ActiveSheet xlapp)
row col
)
)
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-Rowvalues
;;; DESCRIPTION: Returns a list of cell values within a given row
;;; ARGS: row-number(int), startcol, num-cells
;;; EXAMPLE: (DSX-Excel-Get-Rowvalues 3 1 20) get first 20 values in row 3
;;;*************************************************************************
(defun DSX-Excel-Get-Rowvalues
(row startcol numcells / next out)
(dsx-princ "\n(DSX-Excel-Get-Rowvalues)")
(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
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-Columnvalues
;;; DESCRIPTION: Returns a list of cell values within a given column
;;; ARGS: column-number(int), startrow, num-cells
;;; EXAMPLE: (DSX-Excel-Get-Columnvalues 2 1 20) get top-20 entries in column 2 ("B")
;;;*************************************************************************
(defun DSX-Excel-Get-Columnvalues
(col startrow numcells / next out)
(dsx-princ "\n(DSX-Excel-Get-Columnvalues)")
(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
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-GetRangevalues-ByRows
;;; DESCRIPTION: Get range values in row order and return as nested lists
;;; ARGS: startrow, startcol, num-rows, num-cols
;;; EXAMPLE: (DSX-Excel-GetRangevalues-ByRows 1 1 5 10) get range values from 1A to 5J where each sublist is one row
;;;*************************************************************************
(defun DSX-Excel-GetRangevalues-ByRows
(startrow startcol numrows numcols / nextrow rowlst outlst)
(dsx-princ "\n(DSX-Excel-GetRangevalues-ByRows)")
(setq nextrow startrow)
(repeat numrows
(setq rowlst(DSX-Excel-Get-Rowvalues nextrow startcol numcols)
outlst(if outlst (append outlst (list rowlst)) (list rowlst))
nextrow (1+ nextrow)
)
)
outlst
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-GetRangevalues-ByCols
;;; DESCRIPTION: Get range values in column order and return as nested lists
;;; ARGS: startrow, startcol, num-rows, num-cols
;;; EXAMPLE: (DSX-Excel-GetRangevalues-ByCols 1 1 5 10) get range values from 1A to 5J where each sublist is one column
;;;*************************************************************************
(defun DSX-Excel-GetRangevalues-ByCols
(startrow startcol numrows numcols / nextrow nextcol collst outlst)
(dsx-princ "\n(DSX-Excel-GetRangevalues-ByCols)")
(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)
)
)
outlst
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-ActiveWorkSheet
;;; DESCRIPTION: Returns object of active worksheet in active Excel session
;;; ARGS: app (session object)
;;; EXAMPLE: (DSX-Excel-Get-ActiveWorkSheet xlapp)
;;;*************************************************************************
(defun DSX-Excel-Get-ActiveWorkSheet (xlapp)
(dsx-princ "\n(DSX-Excel-Get-ActiveWorkSheet)")
(msxl-get-ActiveSheet xlapp)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-RangeAutoFit
;;; DESCRIPTION: Applies Auto-Fit to columns within active range
;;; ARGS: active-sheet (object)
;;; EXAMPLE: (DSX-Excel-RangeAutoFit myxlws)
;;;*************************************************************************
(defun DSX-Excel-RangeAutoFit (active-sheet)
(dsx-princ "\n(DSX-Excel-RangeAutoFit)")
(vlax-invoke-method
(vlax-get-property
(vlax-get-property
(vlax-get-property active-sheet 'UsedRange)
'Cells
)
'Columns
)
'AutoFit
)
)
(defun DSX-Excel-RangeDataFormat (active-sheet)
(dsx-princ "\n(DSX-Excel-RangeDataFormat)")
(vlax-put-property
(vlax-get-property active-sheet "Cells")
'NumberFormat "@"
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Quit
;;; DESCRIPTION: Quit and close Excel session (app)
;;; ARGS: app (session object)
;;; EXAMPLE: (DSX-Excel-Quit xlapp)
;;;*************************************************************************
(defun DSX-Excel-Quit (appsession)
(dsx-princ "\n(DSX-Excel-Quit)")
(cond
( (not (vlax-object-released-p appsession))
(vlax-invoke-method appsession 'QUIT)
(vlax-release-object appsession)
)
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Kill
;;; DESCRIPTION: Forces any open Excel sessions to be closed
;;; ARGS: none
;;; EXAMPLE: (DSX-Excel-Kill)
;;;*************************************************************************
(defun DSX-Excel-Kill ( / eo)
(while (setq eo (vlax-get-object "Excel.Application"))
(DSX-Excel-Quit eo)
(vlax-release-object eo)
(setq eo nil)
(gc)(gc);; even this doesn't always kill the damn thing!
)
)
;;;*************************************************************************
;;; MODULE:
;;; DESCRIPTION:
;;; ARGS:
;;; EXAMPLE:
;;;*************************************************************************
;;; Remove trailing 'nil' members from a given list
(defun DSX-TrimList (lst)
(cond
( (/= nil (last lst)) lst)
( T
(DSX-TrimList (reverse (cdr (reverse lst))))
)
)
)
;;;*************************************************************************
;;; MODULE:
;;; DESCRIPTION:
;;; ARGS:
;;; EXAMPLE:
;;;*************************************************************************
;;; Convert a list of values into a list of string equivalents
(defun DSX-ListStr (lst / mbr out)
(setq out '())
(foreach mbr lst
(cond
( (= mbr nil) (setq out (cons "" out)) )
( (= (type mbr) 'STR)
(if (member mbr '(" " "" " "))
(setq out (cons "" out))
(setq out (cons mbr out))
)
)
( (= (type mbr) 'INT) (setq out (cons (itoa mbr) out)) )
( (= (type mbr) 'REAL)(setq out (cons (rtos mbr 2 6) out)))
)
)
(reverse out)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-Sheets
;;; DESCRIPTION: Returns SHEETS collection from active workbook
;;; ARGS: Excel-application
;;; EXAMPLE: (setq sheets (DSX-Excel-Sheets xlApp))
;;;*************************************************************************
(defun DSX-Excel-Sheets (xlapp)
(setq xlsheets(vlax-get-property xlapp "sheets"))
)
;;;*************************************************************************
;;; MODULE:DSX-Excel-SheetDelete
;;; DESCRIPTION: Delete sheet (tab) from active workbook sheets collection
;;; ARG: sheet-name, sheets-collection
;;; EXAMPLE: (DSX-Excel-SheetDelete "Sheet3" xlSheets)
;;;*************************************************************************
(defun DSX-Excel-SheetDelete (name xlsheets)
(vlax-for sh xlsheets
(if (= (vlax-get-property sh "Name") name)
(vlax-invoke-method sh "Delete")
)
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-SheetAdd
;;; DESCRIPTION: Add new sheet (tab) to sheets collection in workbook, returns sheet object
;;; ARG: sheet-name, sheets-collection
;;; EXAMPLE: (setq newsheet (DSX-Excel-SheetAdd "SheetX" xlSheets))
;;;*************************************************************************
(defun DSX-Excel-SheetAdd (name xlsheets)
(setq newsheet (vlax-invoke-method xlsheets "Add"))
(vlax-put-property newsheet "Name" name)
newsheet
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-WorkbookSave
;;; DESCRIPTION: Saves active workbook to specified filename, if file exists, it is overwritten if user accepts prompt
;;; ARG: workbook-object, filename
;;; EXAMPLE: (DSX-Excel-WorkbookSave objWB "myfile.xls")
;;;*************************************************************************
(defun DSX-Excel-WorkbookSave (workbook filename)
(if (findfile filename)
(vlax-invoke-method awb "Save")
(vlax-invoke-method awb "SaveAs"
filename msxl-xlNormal "" ""
:vlax-False :vlax-False nil
)
)
)
;;;*************************************************************************
;;; MODULE: DSX-Excel-ActiveWorkbook
;;; DESCRIPTION: Returns active workbook object from given Excel application session
;;; ARG: Excel-application
;;; EXAMPLE: (setq objWB (DSX-Excel-ActiveWorkbook xlApp))
;;;*************************************************************************
(defun DSX-Excel-ActiveWorkbook (xlapp)
(vlax-get-property xlapp "ActiveWorkbook")
)
(princ)
[转贴]：一个值得学习的VLISP与EXCEL之间连接及数据传输和函数集
一个值得学习的VLISP与EXCEL之间连接及数据传输和函数集 谢谢 sqmjk01 ，一时看不明白，好好研究学习。 最近用到。谢谢 谢谢了，，有没有简单点 谢谢分享。值得学习。 曾经的入门样例，随着时间的推移，发现这套代码的效率不敢恭维，用这套代码写出的工具和该公司几个EXCEL导出工具比较就知道了 谢谢楼主的分享 谢谢楼主的分享有没有和word的 看不懂啊看不懂啊看不懂啊 谢谢楼主的分享 确实是难得好帖啊，顶先 学习学习啊！技术贴！ 确实是难得好帖啊，顶先