(vl-load-com)
;;;名称:BF-Excel-New
;;;说明:新建Excel工作簿
;;;参数:ishide:是否可见，t为可见，nil为不可见
;;;返回:一个表示Excel工作簿的vla对象
;;;示例:(BF-Excel-New t)
(Defun BF-Excel-New (ishide / Rtn)
  (if (setq Rtn (vlax-get-or-create-object "Excel.Application"))
    (progn
      (vlax-invoke
	(vlax-get-property Rtn 'WorkBooks)
	'Add
      )
      (if ishide
	(vla-put-visible Rtn 1)
	(vla-put-visible Rtn 0)
      )
    )
  )
  Rtn
)
;;;名称:BF-Excel-Open
;;;说明:打开一个excel文件
;;;参数:Filename:文件路径
;;;参数:ishide:是否可见，t为可见，nil为不可见
;;;返回:一个表示打开的excel文件的vla对象
;;;示例:(BF-Excel-Open "C:\\Users\\vic\\Desktop\\1.xlsx" t)
(Defun BF-Excel-Open (filename	  ishide      /		  ActiveSheet
		      ExcelApp	  Rtn	      Sheets	  WorkSheet
		     )
					;(setq filename (strcase filename))
					;(if (null (wcmatch filename "*.xls"))
					;  (setq filename (strcat filename ".xls"))
					;)
  (if (and (findfile filename)
	   (setq Rtn (vlax-get-or-create-object "Excel.Application"))
      )
    (progn
      (vlax-invoke
	(vlax-get-property Rtn 'WorkBooks)
	'Open
	filename
      )
      (if ishide
	(vla-put-visible Rtn 1)
	(vla-put-visible Rtn 0)
      )
    )
  )
  Rtn
)
;;;名称:BF-Excel-Save
;;;说明:保存当前工作簿
;;;参数:xlsApp:当前工作簿对象
;;;返回:正确保存应该返回t，错误返回nil
;;;示例:(BF-Excel-Save xlsobj)
(Defun BF-Excel-Save (xlsApp)
  (equal (vlax-invoke-method
	   (vlax-get-property xlsApp "ActiveWorkbook")
	   "Save"
	 )
	 :vlax-true
  )
)
;;;名称:BF-Excel-SaveAs
;;;说明:另存为excel文件
;;;参数:XLApp:已打开的excel文件对象
;;;参数:Filename:另存为的文件路径
;;;返回:
;;;示例:(BF-Excel-SaveAs)
(Defun BF-Excel-SaveAs (XLApp Filename)
  (vlax-invoke
    (vlax-get-property XLApp "ActiveWorkbook")
    "SaveAs"
    Filename
  )
)
;;;名称:BF-Excel-Quit
;;;说明:退出excel
;;;参数:ExlObj:打开的excel对象
;;;参数:SaveYN:是否保存，t为保存，nil为不保存
;;;返回:
;;;示例:(BF-Excel-Quit )
(Defun BF-Excel-Quit (ExlObj SaveYN)
  (if SaveYN
    (vlax-invoke
      (vlax-get-property ExlObj "ActiveWorkbook")
      'Close
    )
    (vlax-invoke
      (vlax-get-property ExlObj "ActiveWorkbook")
      'Close
      :vlax-False
    )
  )
  (vlax-invoke ExlObj 'QUIT)
  (vlax-release-object ExlObj)
  (setq ExlObj nil)
  (gc)
)
;;;名称:BF-Excel-QuitAll
;;;说明:退出所有打开的excel文件
;;;参数:SaveYN:是否保存
;;;返回:
;;;示例:(BF-Excel-QuitAll)
(Defun BF-Excel-QuitAll	(SaveYN / ExlObj)
  (while (setq ExlObj (vlax-get-object "Excel.Application"))
    (BF-Excel-Quit ExlObj SaveYN)
  )
)
;;;名称:BF-Excel-getActiveSheet
;;;说明:获取当前工作表的名字
;;;参数:XLApp:打开的excel文件对象
;;;返回:名字字符串
;;;示例:(BF-Excel-getActiveSheet exobj)
(Defun BF-Excel-getActiveSheet (XLApp)
  (vlax-get-property
    (vlax-get-property
      (vlax-get-property XLApp 'ActiveWorkbook)
      'ActiveSheet
    )
    'Name
  )
)
;;;名称:BF-Excel-addSheet
;;;说明:添加个工作表
;;;参数:XLApp:已打开的excel文件对象
;;;参数:Name:工作表名
;;;返回:成功返回t
;;;示例:(BF-Excel-addSheet exobj "123")
(Defun BF-Excel-addSheet (XLApp Name / Rtn)
  (if (member name (BF-Excel-Sheets xlapp))
    (setq Rtn nil)
    (progn
      (vlax-put-property
	(vlax-invoke
	  (vlax-get-property XLApp "sheets")
	  "Add"
	)
	"name"
	Name
      )
      (setq Rtn (equal (BF-Excel-getActiveSheet xlapp) name))
    )
  )
  Rtn
)
;;;名称:BF-Excel-Sheets
;;;说明:获取工作表列表
;;;参数:XLApp:已打开的excel文件对象
;;;返回:工作表名列表
;;;示例:(BF-Excel-Sheets exobj)
(Defun BF-Excel-Sheets (XLApp / Rtn SH)
  (vlax-for SH (vlax-get-property XLApp "sheets")
    (setq Rtn (cons (vlax-get-property sh "Name") Rtn))
  )
  (reverse Rtn)
)
;;;名称:BF-Excel-deleteSheet
;;;说明:删除工作表
;;;参数:XLApp:已打开的excel文件对象
;;;参数:Name:工作表名
;;;返回:成功返回t
;;;示例:(BF-Excel-deleteSheet exobj "123")
(Defun BF-Excel-deleteSheet (XLApp Name / old Rtn sh)
  (setq	Rtn (BF-Excel-Sheets XLApp)
	old (vlax-get-property XLApp "DisplayAlerts")
  )
  (vlax-put-property XLApp "DisplayAlerts" 0)
  (vlax-for sh (vlax-get-property XLApp "sheets")
    (if	(= (vlax-get-property sh "Name") Name)
      (vlax-invoke-method sh "Delete")
    )
  )
  (vlax-put-property XLApp "DisplayAlerts" old)
  (not (equal Rtn (BF-Excel-Sheets XLApp)))
)

;;;名称:BF-Excel-renameSheet
;;;说明:重命名工作表
;;;参数:XLApp:已打开的excel文件对象
;;;参数:Old:工作表原名
;;;参数:New:工作表新名
;;;返回:成功返回t
;;;示例:(BF-Excel-renameSheet  exobj "123" "345")
(Defun BF-Excel-renameSheet (XLApp Old New / Rtn sh)
  (if (null old)
    (setq old (BF-Excel-getActiveSheet XLApp))
  )
  (if (member New (BF-Excel-Sheets XLApp))
    (setq Rtn nil)
    (progn
      (vlax-for	sh (vlax-get-property XLApp "sheets")
	(if (= (vlax-get-property sh 'name) Old)
	  (vlax-put-property sh 'name New)
	)
      )
      (setq Rtn
	     (equal New
		    (BF-Excel-getActiveSheet XLApp)
	     )
      )
    )
  )
  Rtn
)

;;;名称:BF-Excel-setActiveSheet
;;;说明:设置活动工作表
;;;参数:XLApp:已打开的excel文件对象
;;;参数:Name:工作表名
;;;返回:成功返回t
;;;示例:(BF-Excel-setActiveSheet exobj "123")
(Defun BF-Excel-setActiveSheet (XLApp Name / sh)
  (if (member name (BF-Excel-Sheets xlapp))
    (vlax-for sh (vlax-get-property XLApp "sheets")
      (if (= (vlax-get-property sh "Name") Name)
	(vlax-invoke-method sh "Activate")
      )
    )
  )
  (equal (BF-Excel-getActiveSheet xlapp) name)
)

;;;名称:BF-Excel-getUsedRange
;;;说明:获取已使用的range区域
;;;参数:XLApp:已打开的excel文件对象
;;;参数:Name:工作表名
;;;返回:成功返回range对象
;;;示例:(BF-Excel-getUsedRange exobj "345")
(Defun BF-Excel-getUsedRange (XLApp Name / Rtn sh)
  (if (null Name)
    (setq Name (BF-Excel-getActiveSheet XLApp))
  )
  (vlax-for sh (vlax-get-property XLApp "sheets")
    (if	(= (vlax-get-property sh "Name") Name)
      (setq Rtn (vlax-get-property sh "UsedRange"))
    )
  )
  Rtn
)
;;;名称:BF-Excel-getSelection
;;;说明:获取选择区域的索引
;;;参数:xlapp:已打开的excel文件对象
;;;返回:A1格式的索引
;;;示例:(BF-Excel-getSelection exobj)
(defun BF-Excel-getSelection (xlapp)
  (BF-Excel-getRangeIndex
    (vlax-get-property xlapp 'Selection)
  )
)
;;;名称:BF-Excel-getRangeIndex
;;;说明:获取range的索引
;;;参数:range:range对象
;;;返回:A1格式的索引
;;;示例:(BF-Excel-getRangeIndex xlrange)
(Defun BF-Excel-getRangeIndex (range / str col row dx dy)
  (if (equal (BF-get-property range "mergecells")
	     :vlax-true
      )
    (setq str "MergeArea.")
    (setq str "")
  )
  (setq	dx  (BF-get-property range (strcat str "Rows.Count"))
	dy  (BF-get-property range (strcat str "Columns.Count"))
	row (BF-get-property range (strcat str "Row"))
	col (BF-get-property range (strcat str "Column"))
  )
  (BF-Excel-Utils-index-cells->range
    (list row col (1- (+ row dx)) (1- (+ col dy)))
  )
)

;;;名称:BF-Excel-getRangeValue
;;;说明:获取单元格或区域的值
;;;参数:XLApp:已打开的excel文件对象
;;;参数:index:位置信息，如"A1"或者'(1 1), "A1:B2"或者'(1 1 2 2)
;;;返回:值的列表
;;;示例:(BF-Excel-getRangeValue exobj "A1:B2")
(Defun BF-Excel-getRangeValue (XLApp index)
  (BF-Excel-Utils-GetValue
    (vlax-get-property
      (BF-Excel-getRange XLApp index)
      'value2
    )
  )
)

;;;名称:BF-Excel-setRangeValue
;;;说明:设置单元格或区域的值
;;;参数:XLApp:已打开的excel文件对象
;;;参数:index:位置信息，如"A1"或者'(1 1), "A1:B2"或者'(1 1 2 2)
;;;参数:value:要设置的值列表或者字符串/数字等
;;;返回:
;;;示例:(BF-Excel-setRangeValue exobj '(1 1) 2)
(Defun BF-Excel-setRangeValue (XLApp index value / range)

  (setq range (BF-Excel-getRange XLApp index))
  (if (= 'list (type value))
    (progn
        (if (= 'list (type (car value)))
			(setq Value (apply 'append value))
		)
        (vlax-for it range
	        (vlax-put-property it 'value2 (car value))
	        (setq value (cdr value))
        )
    )
    (progn
        (vlax-for	it range
	        (vlax-put-property it 'value2 value)
        )
    )
  )
)

;;;名称:BF-Excel-setBackcolor
;;;说明:设置充填色
;;;参数:xlapp:已打开的excel文件对象
;;;参数:index:区域索引，A1引用格式或者行列表
;;;参数:colorindex:颜色索引0-56号
;;;返回:
;;;示例:(BF-Excel-setBackcolor exobj "A1" 6)
(defun BF-Excel-setBackcolor (xlapp index colorindex)
  (vlax-put-property
    (vlax-get-property
      (BF-Excel-getRange xlapp index)
      'interior
    )
    'colorindex
    colorindex
  )
)
;;;名称:BF-Excel-getBackcolor
;;;说明:获取充填色
;;;参数:xlapp:已打开的excel文件对象
;;;参数:index:区域索引，A1引用格式或者行列表
;;;返回:颜色索引字符串 0-56 号
;;;示例:(BF-Excel-getBackcolor exobj "A1")
(defun BF-Excel-getBackcolor (xlapp index)

  (BF-Excel-Utils-GetValue
    (vlax-get-property
      (vlax-get-property
	(BF-Excel-getRange xlapp index)
	'interior
      )
      'colorindex
    )
  )
)

;;;名称:BF-Excel-ECI->Truecolor
;;;说明:将excel颜色索引转换为真彩色值
;;;参数:Color:excel颜色索引
;;;返回:真彩色值
;;;示例:(BF-Excel-ECI->Truecolor 6)
(defun BF-Excel-ECI->Truecolor (Color / tmp)
  (cond
    ((setq tmp (assoc Color *xls-color*))
     (caddr tmp)
    )
    (t 16711935)
  )
)

;;;名称:BF-Excel-ECI->ACI
;;;说明:将excel颜色索引转换为cad颜色索引
;;;参数:Color:excel颜色索引
;;;返回:cad颜色索引
;;;示例:(BF-Excel-ECI->ACI 6)
(defun BF-Excel-ECI->ACI (Color / tmp)
  (cond
    ((setq tmp (assoc Color *xls-color*))
     (cadr tmp)
    )
    (t 256)
  )
)

;;;名称:BF-Excel-ACI->ECI
;;;说明:将cad颜色索引转换为excel颜色索引
;;;参数:Color:cad颜色索引
;;;返回:excel颜色索引
;;;示例:(BF-Excel-ACI->ECI 2)
(defun BF-Excel-ACI->ECI (Color / tmp)
  (if (setq tmp	(vl-remove-if-not
		  '(lambda (x) (= (cadr x) Color))
		  *xls-color*
		)
      )
    (caar tmp)
    0
  )
)

;;;名称:BF-Excel-ACI->Truecolor
;;;说明:将cad颜色索引转换为真彩色值
;;;参数:aci:cad颜色索引
;;;返回:真彩色值
;;;示例:(BF-Excel-ACI->Truecolor)
(defun BF-Excel-ACI->Truecolor (aci)
  (BF-Excel-ECI->Truecolor (BF-Excel-ACI->ECI aci))
)
;;;名称:BF-Excel-MergeRange
;;;说明:合并单元格
;;;参数:xlapp:已打开的excel文件对象
;;;参数:index:区域索引，A1引用格式或者行列表
;;;返回:
;;;示例:(BF-Excel-MergeRange exobj "A1:B2")
(defun BF-Excel-MergeRange (xlapp index / range)
  (vlax-invoke-method
    (BF-Excel-getRange
      xlapp
      (BF-Excel-Utils-index-cells->range index)
    )
    'Merge
  )
  (BF-Excel-getRange XLApp index)
)
;;;名称:BF-Excel-getRange
;;;说明:根据索引获取range对象
;;;参数:xlapp:已打开的excel文件对象
;;;参数:index:区域索引，A1引用格式或者行列表
;;;返回:range对象
;;;示例:(BF-Excel-getRange exobj "A1")
(defun BF-Excel-getRange (xlapp index)
  (vlax-get-property
    (vlax-get-property
      (vlax-get-property xlapp 'ActiveWorkbook)
      'ActiveSheet
    )
    'range
    (BF-Excel-Utils-index-cells->range index)
  )
)
;;;名称:BF-Excel-UnmergeRange
;;;说明:分解合并单元格
;;;参数:xlapp:已打开的excel文件对象
;;;参数:index:区域索引，A1引用格式或者行列表
;;;返回:分解后的range对象
;;;示例:(BF-Excel-UnmergeRange exobj "A1")
(defun BF-Excel-UnmergeRange (XLApp index / Rtn)
  (setq index (BF-Excel-Utils-index-cells->range index))
  (if (BF-Excel-Range-Mergep XLApp index)
    (progn
      (vlax-invoke-method
	(BF-Excel-getRange XLApp index)
	'unmerge
      )
      (setq Rtn (BF-Excel-getRange XLApp index))
    )
  )
  Rtn
)

;;;名称:BF-Excel-Range-Mergep
;;;说明:判断是否是合并单元格
;;;参数:xlapp:已打开的excel文件对象
;;;参数:index:区域索引，A1引用格式或者行列表
;;;返回:是，返回t，否，返回nil
;;;示例:(BF-Excel-Range-Mergep exobj "A1")
(defun BF-Excel-Range-Mergep (XLApp index)
  (equal
    (vlax-variant-value
      (vlax-get-property
	(BF-Excel-getRange
	  XLApp
	  (BF-Excel-Utils-index-cells->range index)
	)
	'mergecells
      )
    )
    :vlax-true
  )
)

;;;名称:BF-Excel-getMergeIndex
;;;说明:获取合并单元格的索引
;;;参数:xlapp:已打开的excel文件对象
;;;参数:index:区域索引，A1引用格式或者行列表
;;;返回:A1格式的索引
;;;示例:(BF-Excel-getMergeIndex)
(defun BF-Excel-getMergeIndex (XLApp index / Rtn)
  (if (BF-Excel-Range-Mergep XLApp index)
    (progn
      (vlax-invoke-method (BF-Excel-getRange XLApp index) 'select)
      (setq Rtn (BF-Excel-getSelection XLApp))
    )
  )
  Rtn
)
;;;名称:BF-get-property
;;;说明:检索 VLA 对象的特性
;;;参数:obj:vla对象
;;;参数:prop:符号或字符串，标识要检索的特性，字符串的时候可以直接调用多级特性："Rows.Count"
;;;返回:特性的值
;;;示例:(BF-get-property range "MergeArea.Rows.Count")
(defun BF-get-property (obj prop / rtn)
  (cond	((= (type prop) 'sym)
	 (setq Rtn (vlax-get-property obj prop))
	)
	((= (type prop) 'str)
	 (if (null (vl-string-search "." prop))
	   (setq Rtn (vlax-get-property obj prop))
	   (foreach item (BF-str->lst prop ".")
	     (if (null Rtn)
	       (setq Rtn (vlax-get-property obj 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
)

;;;名称:BF-Excel-Utils-index-cells->range
;;;说明:工具函数，将行号、列标表转换成A1格式的引用
;;;参数:lst:行号、列标表，列最多支持到ZZ列
;;;返回:A1格式的引用
;;;示例:(BF-Excel-Utils-index-cells->range '(1 2 3 4))
(defun BF-Excel-Utils-index-cells->range (lst / num->col)
  (defun num->col (n)			;数字转为列，leemac
    (if	(< n 27)
      (chr (+ 64 n))
      (strcat (num->col (/ (1- n) 26))
	      (num->col (1+ (rem (1- n) 26)))
      )
    )
  )
  (if (= 'list (type lst))
    (cond
      ((= 2 (length lst))
       (strcat (num->col (cadr lst)) (itoa (car lst)))
      )
      ((= 4 (length lst))
       (strcat (num->col (cadr lst))
	       (itoa (car lst))
	       ":"
	       (num->col (last lst))
	       (itoa (caddr lst))
       )
      )
      (t
       "A1"
      )
    )
    lst
  )
)


;;;名称:BF-Excel-Utils-index-range->cells
;;;说明:工具函数，将A1格式的引用转换成行号、列标表
;;;参数:var:A1格式的字符串
;;;返回:行号、列标表
;;;示例:(BF-Excel-Utils-index-range->cells "DD23:EE44")
(defun BF-Excel-Utils-index-range->cells (var / index str->list)
  (defun str->list (str)
    (list
      (read (vl-list->string
	      (vl-remove-if-not
		'(lambda (x) (<= 48 x 57))
		(vl-string->list str)
	      )
	    )
      )
      ((lambda (f) ;leemac
	 (f (reverse (vl-remove-if
		       '(lambda (x) (<= 48 x 57))
		       (vl-string->list str)
		     )
	    )
	 )
       )
	(lambda	(l)
	  (if l
	    (+ (* 26 (f (cdr l))) (- (car l) 64))
	    0
	  )
	)
      )
    )
  )
  (if (setq index (vl-string-position 58 var))
    (append
      (str->list (substr var 1 index))
      (str->list (substr var (+ 2 index)))
    )
    (str->list var)
  )
)
;;;名称:BF-Excel-Utils-index-offset
;;;说明:根据行列偏移量计算单元格索引
;;;参数:BaseCellId:基础单元格索引，可以为A1引用格式或者行列数字列表
;;;参数:rowOffset:行偏移量
;;;参数:columnOffset:列偏移量
;;;返回:A1格式的单元格索引
;;;示例:(BF-Excel-Utils-index-offset "A1" 2 3)
(defun BF-Excel-Utils-index-offset (BaseCellId rowOffset columnOffset)
  (if (= 'str (type BaseCellId))
    (setq BaseCellId (BF-Excel-Utils-index-range->cells BaseCellId))
  )
  (BF-Excel-Utils-index-cells->range
    (mapcar '+ BaseCellId (list rowOffset columnOffset))
  )
)


;;;名称:BF-Excel-Utils-GetValue
;;;说明:工具函数，获取变体的值
;;;参数:var:变体
;;;返回:值列表，其中数字全部转换为字符串
;;;示例:(BF-Excel-Utils-GetValue obj)
(defun BF-Excel-Utils-GetValue (var)
  (cond
    ((= 'list (type var))
     (mapcar 'BF-Excel-Utils-GetValue var)
    )
    ((= 'variant (type var))
     (BF-Excel-Utils-GetValue
       (vlax-variant-value
	 (if (member (vlax-variant-type Var) '(5 4 3 2))
	   (setq Var (vlax-variant-change-type Var vlax-vbString))
	   var
	 )
       )
     )
    )
    ((= 'safearray (type var))
     (mapcar 'BF-Excel-Utils-GetValue (vlax-safearray->list var))
    )
    (T var)
  )
)

;;定义excel-cad-truecolor 颜色索引表常量
(setq *xls-color*
       '(
	 (1 18 0)
	 (2 7 1677215)
	 (3 1 16711680)
	 (4 3 65280)
	 (5 5 255)
	 (6 2 16776960)
	 (7 6 16711935)
	 (8 4 65535)
	 (9 16 8323072)
	 (10 96 32512)
	 (11 176 127)
	 (12 56 8355584)
	 (13 216 8323199)
	 (14 136 32639)
	 (15 9 12566463)
	 (16 8 8355711)
	 (17 161 9476095)
	 (18 237 9449568)
	 (19 7 1677167)
	 (20 254 12648447)
	 (21 218 6291552)
	 (22 11 16744319)
	 (23 152 24768)
	 (24 254 13617407)
	 (25 176 127)
	 (26 6 16711935)
	 (27 2 16776960)
	 (28 4 65535)
	 (29 216 8323199)
	 (30 16 8323072)
	 (31 136 32639)
	 (32 5 255)
	 (33 140 51455)
	 (34 254 12648447)
	 (35 254 13631439)
	 (36 51 16777104)
	 (37 151 9488639)
	 (38 221 16750799)
	 (39 191 13605119)
	 (40 31 16763024)
	 (41 150 3105023)
	 (42 132 3131584)
	 (43 62 9488384)
	 (44 40 16762880)
	 (45 30 16750336)
	 (46 30 16738048)
	 (47 165 6317968)
	 (48 252 9475984)
	 (49 148 12384)
	 (50 105 3184736)
	 (51 98 12032)
	 (52 48 3158016)
	 (53 24 9449472)
	 (54 237 9449311)
	 (55 177 3158160)
	 (56 250 3092527)
	)
)