与ACAD的VBA一样，MS EXCEL也提供ActiveX对象模型，在ACAD VBA开发中使用EXCEL文档同样也要通过其ActiveX对象模型。详细介绍EXCEL的ActiveX对象模型恐怕离ACAD太远，也没有必要。在这只说说获取EXCEL工作表指定单元格内容的方法。 与ACAD的ActiveX对象模型一样，EXCEL的ActiveX对象模型其顶层对象也是Application对象，EXCEL.Application对象提供的Workbooks工作簿集合对象包含有全部已经启动的EXCEL工作簿对象，我们可以使用Application对象的ActiveWorkbook方法来获取当前活动的工作簿对象，也可以使用Workbooks(Index)方法来得到指定的工作簿对象。获取要操作的工作簿后，需要获取工作簿中的指定工作表(worksheet)才能访问到其中的指定单元格内容。EXCEL的单元格的确定由行和列唯一指定，例如Range(\"B4\")表示第4行第2列。
下面的代码从EXCEL文档中读出数据并在ACAD图形的模型空间中自动根据EXCEL文档内容绘图。行号是我加上的，真正的程序不需要它们。 1 Sub ExcelRead()
2 Dim ExcelApp As New Excel.Application
3 ExcelApp.Workbooks.Open \"d:\\book1.xls\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 34 End 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
VBA读写EXCEL文档的一般方法
与ACAD的VBA一样，MS EXCEL也提供ActiveX对象模型，在ACAD VBA开发中使用EXCEL文档同样也要通过其ActiveX对象模型。详细介绍EXCEL的ActiveX对象模型恐怕离
ACAD太远，也没有必要。在这只说说获取EXCEL工作表指定单元格内容的方法。
与ACAD的ActiveX对象模型一样，EXCEL的ActiveX对象模型其顶层对象也是Application对象，EXCEL.Application对象提供的Workbooks工作簿集合对象包含有全部已经启动的EXCEL工作簿对象，我们可以使用Application对象的ActiveWorkbook方法来获取当前活动的工作簿对象，也可以使用Workbooks(Index)方法来得到指定的工作簿对象。获取要操作的工作簿后，需要获取工作簿中的指定工作表(worksheet)才能访问到其中的指定单元格内容。EXCEL的单元格的确定由行和列唯一指定，例如Range(\"B4\")表示第4行第2列。
下面的代码从EXCEL文档中读出数据并在ACAD图形的模型空间中自动根据EXCEL文档内容绘图。行号是我加上的，真正的程序不需要它们。 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 34 End 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
因篇幅问题不能全部显示，请点此查看更多更全内容