【转帖】[求助]excel不能另存？
 

[求助]excel不能另存？
www.dimcax.com
[求助]excel不能另存？
前几天我搞了一个小vba宏，作用是把在acad中获取的一些数据通过一些计算，然后输入到excel模板文件中，再另存。由于进行了多次调试，后来竟发现不能正常另存（起先是可以的），具体症状是：运行到另存这条语句时，似乎跳到了某个陷阱中，总是运行不结束，当然也不报错。想请各位前辈分析分析，是怎么回事，先谢谢了！
代码粘贴如下：
private sub commandbutton1_click()
userform1.hide
dim cir as acadregion: dim li as double: dim lili as double 'li=面域周长 lili=合计面域周长
dim th(0 to 6) as double: dim opo as integer 'opo=小孔数
dim i as integer
dim plate as integer: plate = 6
dim ty as string: ty = "冲修" 'ty = 模具类型
'dim path1 as string
'path1 = thisdrawing.path 'path1 = 文件另存路径
th(0) = cdbl(textbox1.text)
th(1) = cdbl(textbox2.text)
th(2) = cdbl(textbox3.text)
th(3) = cdbl(textbox4.text)
th(4) = cdbl(textbox5.text)
th(5) = cdbl(textbox6.text)
th(6) = 56


dim excelapp as new excel.application
excelapp.workbooks.open "f:\工作目录\btl\成本预算\temp\线割加工单.xls"
with excelapp.activeworkbook.worksheets("sheet1")
.range("c" & 9) = textbox7.text
.range("g" & 9) = textbox8.text
.range("b" & 11) = "凸凹模"
.range("b" & 12) = "内退料"
.range("b" & 13) = "外退料"
.range("b" & 14) = "下垫板"
.range("b" & 15) = "凹模"
.range("b" & 16) = "上固板"
.range("b" & 17) = "异形冲头"
if optionbutton2.value = true then
th(2) = 40
plate = 3: ty = "翻边"
.range("b" & 11) = "凹模"
.range("b" & 12) = "退料板"
.range("b" & 13) = "凸模"
.range("b" & 14) = "上固板"
.range("b" & 15) = ""
.range("b" & 16) = ""
.range("b" & 17) = ""
.range("b" & 18) = ""
elseif optionbutton3.value = true then
th(2) = 40
plate = 3: ty = "包胎"
.range("b" & 11) = "凹模"
.range("b" & 12) = "退料板"
.range("b" & 13) = "凸模"
.range("b" & 14) = "上固板"
.range("b" & 15) = ""
.range("b" & 16) = ""
.range("b" & 17) = ""
.range("b" & 18) = ""
end if
.range("k" & 9) = ty
dim sset as acadselectionset '定义选择集
on error resume next
for ii = 0 to plate
set sset = thisdrawing.selectionsets.add("sz4")
dim filtertype(0) as integer: dim filterdata(0) as variant
filtertype(0) = 0: filterdata(0) = "region" '过滤条件
sset.selectonscreen filtertype, filterdata
opo = 0: lili = 0
for each cir in sset

li = cir.perimeter
cir.color = 2
if li < 1000 / th(i) then
cir.color = 4
li = 0
opo = opo + 1
end if
lili = lili + li
next
sset.delete

.range("d" & 11 + i) = th(i)
.range("e" & 11 + i) = opo
.range("g" & 11 + i) = lili
i = i + 1
next ii
end with
excelapp.activeworkbook.saveas "d:\book2.xls" '(path1 & "\" & textbox8.text & ty & ".xls")

excelapp.workbooks.close
excelapp.quit
thisdrawing.application.update
end sub
以下是源码
通过工具菜单->加载应用程序 可加载dvb文件，然后通过工具菜单->宏->运行宏 来运行相应程序。如需要每次启动时均加载该程序，则可以将该文件放在启动组中。