高手！
<p>谢谢,我马上试试</p>
好，不错！
写的简单明了，我不知道怎么给你送鲜花。如果不嫌麻烦，下面写入excel这段能不能再解释一下，你可能觉得很简单，对我等初级的还有点问题，我也想写一个相关应用的程序
<p>很详细，试一下</p><p></p>
<p>楼主,我是新人,我想问一下,怎么才能在VBA中引用EXCEL某个单元格中的部分内容,</p>
怎么什么都没有啊
<p>您好，我是新注册不久的会员。《VBA读写EXCEL文档的一般方法》一文，打开后看不到具体内容啊？我急需学习这方面的知识，请帮帮忙，谢谢了！！</p>
leeyeafu发表于2003-10-19 11:45:00static/image/common/back.gif与ACAD的VBA一样，MS EXCEL也提供ActiveX对象模型，在ACAD VBA开发中使用EXCEL文档同样也要通过其ActiveX对象模型。详细介绍EXCEL的ActiveX对象模型恐怕离ACAD太远，也没有必要。在这只说说获取
1 Sub ExcelRead()
2 Dim ExcelApp As New Excel.Application
3 ExcelApp.Workbooks.Open "d:\book1.xls", , ReadOnly
4 Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double
5 Dim Rad As Double
6 Dim i As Integer
7 i = 2
8 With ExcelApp.ActiveWorkbook.Worksheets("sheet1")
9 Do
10 Select Case .Range("A" & i)
11 Case "直线":
12 pt1(0) = .Range("B" & i)
13 pt1(1) = .Range("C" & i)
14 pt1(2) = 0
15 pt2(0) = .Range("D" & i)
16 pt2(1) = .Range("E" & i)
17 pt2(0) = 0
18 ThisDrawing.ModelSpace.AddLine pt1, pt2
19 Case "圆":
20 pt1(0) = .Range("B" & i)
21 pt1(1) = .Range("C" & i)
22 pt1(2) = 0
23 Rad = .Range("D" & i)
24 ThisDrawing.ModelSpace.AddCircle pt1, Rad
25 Case Else:
26 Exit Do
27 End Select
28 i = i + 1
29 Loop
30 End With
31 ExcelApp.Workbooks.Close
32 ExcelApp.Quit
33 ThisDrawing.Application.Update
34End Sub
运行这段代码需要加载EXCEL ActiveX对象模型。在ACAD VBA编辑器中选择“工具”菜单->“引用”，选择合适的Microsoft Excel Object Library。
这段代码第2行先声明并新建一个EXCEL.Application对象。新建EXCEL对象，也可以调用VB库函数CreateObject()：
Dim ExcelApp As Excel.Application
Set ExcelApp = CreateObject("Microsoft Excel")
程序第3行调用EXCEL的Application对象的Workbooks集合的Open方法，以只读方式打开指定的EXCEL文档。第4-7行声明一些变量。i 用于表明要操作的EXCEL单元格的行号，通常EXCEL文档第1 行是表头说明，我们从第2行开始读数据。
程序第8行告诉编译程序以下对当前活动的EXCEL文档的Sheet1工作表进行操作。
程序第9行到第29行循环读取EXCEL文档的Sheet1工作表中对于自动绘图有用的单元格内容并在ACAD模型空间中绘图。
循环内部用Select Case语句根据EXCEL文档的第1 列内容选择不同的绘图方法。为了说明问题，程序仅对直线和圆两种ACAD图元对象进行操作并将其它对象出现作为循环退出条件。实际编程时可以对更多ACAD图元对象进行操作。
程序第31、32行释放不再使用的EXCEL对象，第33行刷新ACAD图形以显示自动绘制的图形。
下面的代码由用户在ACAD图形中选择对象并将对象部分属性写入EXCEL文档。
Sub WriteExcel()
Dim ExcelApp As New Excel.Application
Dim ExcelWkbk As Excel.Workbook
Set ExcelWkbk = ExcelApp.Workbooks.Add
Dim sel As AcadSelectionSet
Dim i As Integer
i = 2
On Error Resume Next
Set sel = ThisDrawing.SelectionSets.Add("ssel")
If Err Then
Err.Clear
Set sel = ThisDrawing.SelectionSets.Item("ssel")
End If
On Error GoTo 0
sel.SelectOnScreen
Dim Ent As AcadEntity
Dim pt1 As Variant, pt2 As Variant
MsgBox ExcelWkbk.Name
With ExcelWkbk.Worksheets("sheet1")
For Each Ent In sel
Select Case UCase(Ent.ObjectName)
Case "ACDBLINE":
.Range("A" & i) = "直线"
pt1 = Ent.StartPoint
pt2 = Ent.EndPoint
.Range("B" & i) = pt1(0)
.Range("c" & i) = pt1(1)
.Range("D" & i) = pt2(0)
.Range("E" & i) = pt2(1)
i = i + 1
Case "ACDBCIRCLE":
.Range("A" & i) = "圆"
pt1 = Ent.Center
.Range("B" & i) = pt1(0)
.Range("C" & i) = pt1(1)
.Range("D" & i) = Ent.Radius
i = i + 1
Case Else:
End Select
Next Ent
End With
ExcelApp.ActiveWorkbook.SaveAs "d:\book1.xls"
ExcelApp.Workbooks.Close
ExcelApp.Quit
sel.Delete
End Sub