难道标题不够醒目，还是问题有些棘手，希望给位老大能看看
放假这几天天都在线等，等的好辛苦
版主大人，帮忙看看吧
不能沉
一直等
这种大型的程序我想应该不会有谁会免费花时间帮你写吧
有个turetable的插件，专门处理CAD与EXCEL表格数据转换的，楼主可以试试。
sicky111 发表于 2013-5-5 15:29 static/image/common/back.gif
有个turetable的插件，专门处理CAD与EXCEL表格数据转换的，楼主可以试试。
谢谢您的支持
陨落 发表于 2013-5-5 13:04 static/image/common/back.gif
这种大型的程序我想应该不会有谁会免费花时间帮你写吧
嗯~有可能吧，谢谢您的支持
老大，在吗？帮帮小弟
求人不如求己啊，自己看看代码，真的不难，看着你比较诚心的份上，发一下代码，提前说明一下，其中大部分代码都是来自本论坛的。
;; 第一步: Excel 家住在哪里呢？打个114电话查询一下
;; 函数: ddd-TypeLib-Excel
;; 功能: 寻找 Excel 的安装路径
;; 返回: 返回 excel.exe 的全路径
(defun ddd-TypeLib-Excel ( / sysdrv tlb GGG)
(setq sysdrv (getenv "systemdrive"))
;;先从注册表中搜索安装位置，把这一句放在前面的好处是，如果遇到了excel新发布的版本，也可以顺利找到路径。
(and (setq GGG (vl-registry-read
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\Excel.EXE" "Path"))
(setq tlb (findfile (strcase (strcat GGG "Excel.EXE")))))
(if (null tlb)
(cond;;从windows系统盘搜索excel的安装位置
((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office11\\Excel.exe"))) tlb);;2003
((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office12\\Excel.exe"))) tlb);;2007
((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office14\\Excel.exe"))) tlb);;2010
))
(if tlb tlb (princ "\n 未找到 Excel 2003\\2007\\2010 的安装路径"))
)
;; 第二步: 砰 砰 砰，Excel，有事找你，请开个门吧。Excel: 门没锁你自己进来吧。
;; 函数: ddd-Load-Excelapp
;; 功能: 定义 Excel 的类型库接口
(defun ddd-Load-Excelapp ( / tlbfile tlbver out)
(cond
((null msxl-xl24HourClock)
(if (setq tlbfile (ddd-TypeLib-Excel))
(progn(setq tlbver (substr (vl-filename-base tlbfile) 6))
(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
)
;; 第三步: 进入excel家里，我这里有一份数据能放在你家吗？Excel: 可以，我把保险柜钥匙(*ddd-xlapp*)给你
;; 函数: Open-Excel-New
;; 功能: 打开带有新的工作簿的 Excel
;; 参数: <dmode> 可以设为 "SHOW" (显示)或 "HIDE" (隐藏)，它取决于你希望
;; Excel 进程是否可以让用户直接操作访问。
;; 返回: *ddd-xlapp* 全局变量
;; 样例: (Open-Excel-New "SHOW")
(defun Open-Excel-New (dmode / appsession)
(ddd-Load-Excelapp)
(princ "\n 创建一个新的 Excel 电子表格文件...")
(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)
)
)
)(setq *ddd-xlapp* appsession)
)
;; 第四步: 拿到钥匙(*ddd-xlapp*)，有数据随时可以保存了。
;; 函数: vlxls-cell-put-value
;; 功能: 指定单元格开始赋值
;; 参数: <xl> as object 钥匙 <id> as string 在excel单元格的位置 <data> as lists 需要保存的数据
;; 需要自定义函数: ddd-vlxls-cellidcalc / ddd-vlxls-cellid / ddd-vlxls-rangeid 的支持
;; 样例:
;; (vlxls-cell-put-value *ddd-xlapp* "C12:F3" "xx")
;; (vlxls-cell-put-value *ddd-xlapp* "A1" '(("zz" "xx") ("xx" "zz")))
(defun vlxls-cell-put-value (xl id Data / idx xx yy ary Rtn)
(defun vllist-explode (lst)
(cond
((not lst) nil)
((atom lst) (list lst))
((append (vllist-explode (car lst))
(vllist-explode (cdr lst))
)
)
)
)
(if (null id) (setq id "A1" ))
(if (= (type id) 'list) (setq id (ddd-vlxls-rangeid id)))
(if (= (type (car Data)) 'LIST)
(setq ARY (vlax-make-safearray
vlax-vbstring
(cons 0 (1- (length Data)))
(cons 1 (length (car Data)))
)
XX (1- (length (car Data)))
YY (1- (length Data))
)
(setq ARY (vlax-make-safearray
vlax-vbstring
(cons 0 1)
(cons 1 (length Data))
)
XX (1- (length Data))
YY 0
)
)
(if (= xx yy 0)
(msxl-put-value2
(setq Rtn (msxl-get-range xl id))
(car (vllist-explode data))
)
(progn
(setq id (ddd-vlxls-cellidcalc id xx yy))
(msxl-put-value2
(setq Rtn (msxl-get-range xl id))
(vlax-safearray-fill ary data)
)
)
)
Rtn
)
;; Excel 数据保存支持函数
;; 功能: 计算数据填的充范围
(Defun ddd-vlxls-cellidcalc (id x y / idx)
(setq id (car (ddd-vlxls-cellid id))
idx (ddd-vlxls-rangeid id)
x (+ x (car idx))
x (if (< x 1) 1 x)
y (+ y (cadr idx))
y (if (< y 1) 1 y)
idx (ddd-vlxls-rangeid (list x y))
id (ddd-vlxls-cellid (strcat id ":" idx))
id (strcat (car id) ":" (cadr id)))
id
)
;; Excel 数据保存支持函数
;; 功能: Range格式转为表
;; 样例:
;; (ddd-vlxls-cellid '(3 14)) return: ("C14" "")
(Defun ddd-vlxls-cellid (id / xx id1 id2 Rtn) ;;;;cell id 转换
(if (= (type id) 'list) (setq id (ddd-vlxls-rangeid id)))
(setq id (strcase id))
(if (null (setq xx (vl-string-search ":" id)))
(setq Rtn (list id ""))
(setq id1 (substr id 1 xx)
id2 (substr id (+ xx 2))
id1 (ddd-vlxls-rangeid id1)
id2 (ddd-vlxls-rangeid id2)
Rtn (list (ddd-vlxls-rangeid (list (min (car id1) (car id2))
(min (cadr id1) (cadr id2))))
(ddd-vlxls-rangeid (list (max (car id1) (car id2))
(max (cadr id1) (cadr id2)))))
)
) Rtn
)
yxp 发表于 2013-5-6 06:50 static/image/common/back.gif
求人不如求己啊，自己看看代码，真的不难，看着你比较诚心的份上，发一下代码，提前说明一下，其中大部分代 ...
终于看希望了，谢谢您
我只能看懂一些简单的代码
像这样的有难度的代码对我来讲简直就像天书，我本身不是学英语的多数都看不懂
如果您时间方便的话，能不能按上面的要求给小弟编一段程序