读写EXCEL文档的一般方法

1、 VBA读写EXCEL文档的一般方法与ACAD的VBA一样，MS EXCEL也提供ActiveX对象模型，在ACAD VBA开发中使用EXCEL文档同样也要通过其ActiveX对象模型。详细介绍EXCEL的ActiveX对象模型恐怕离ACAD太远，也没有必要。在这只说说获取EXCEL工作表指定单元格内容的方法。与ACAD的ActiveX对象模型一样，EXCEL的ActiveX对象模型其顶层对象也是Application对象，EXCEL.Application对象提供的Workbooks工作簿集合对象包含有全部已经启动的EXCEL工作簿对象，我们可以使用Applic

2、ation对象的ActiveWorkbook方法来获取当前活动的工作簿对象，也可以使用Workbooks(Index)方法来得到指定的工作簿对象。获取要操作的工作簿后，需要获取工作簿中的指定工作表(worksheet)才能访问到其中的指定单元格内容。EXCEL的单元格的确定由行和列唯一指定，例如Range("B4")表示第4行第2列。下面的代码从EXCEL文档中读出数据并在ACAD图形的模型空间中自动根据EXCEL文档内容绘图。行号是我加上的，真正的程序不需要它们。1    Sub ExcelRead()2 

3、60;     Dim ExcelApp As New Excel.Application3        "d:book1.xls", , ReadOnly4       Dim pt1(0 To 2) As Double, pt2(0 To

4、60;2) As Double5       Dim Rad As Double6       Dim i As Integer7       i = 28       With ExcelApp.Active

5、Workbook.Worksheets("sheet1")9       Do10        Select Case .Range("A" & i)11           Case "直线":12 

6、0;           pt1(0) = .Range("B" & i)13             pt1(1) = .Range("C" & i)14     

7、0;       pt1(2) = 015             pt2(0) = .Range("D" & i)16             pt2(1) = 

8、;.Range("E" & i)17             pt2(0) = 018             pt1, pt219         Case &

9、quot;圆":20            pt1(0) = .Range("B" & i)21            pt1(1) = .Range("C" & i)22   

10、60;        pt1(2) = 023            Rad = .Range("D" & i)24            pt1, Rad25  

11、;      Case Else:26            Exit Do27      End Select28      i = i + 129    Loop30 

12、0;  End With31    ExcelApp.Workbooks.Close32    ExcelApp.Quit33    ThisDrawing.Application.Update34  End Sub运行这段代码需要加载EXCEL ActiveX对象模型。在ACAD VBA编辑器中选择“工具”菜单->“引用”，选择合适的Microsoft Excel Ob

13、ject Library。这段代码第2行先声明并新建一个EXCEL.Application对象。新建EXCEL对象，也可以调用VB库函数CreateObject()：  Dim ExcelApp As Excel.Application   Set ExcelApp = CreateObject("Microsoft Excel")程序第3行调用EXCEL的Application对象的Workbooks集合的Open方法，以只读方式打开指定的EX

14、CEL文档。第4-7行声明一些变量。i 用于表明要操作的EXCEL单元格的行号，通常EXCEL文档第1 行是表头说明，我们从第2行开始读数据。程序第8行告诉编译程序以下对当前活动的EXCEL文档的Sheet1工作表进行操作。程序第9行到第29行循环读取EXCEL文档的Sheet1工作表中对于自动绘图有用的单元格内容并在ACAD模型空间中绘图。循环内部用Select Case语句根据EXCEL文档的第1 列内容选择不同的绘图方法。为了说明问题，程序仅对直线和圆两种ACAD图元对象进行操作并将其它对象出现作为循环退出条件。实际编程时可以对更多ACAD图元对象

15、进行操作。程序第31、32行释放不再使用的EXCEL对象，第33行刷新ACAD图形以显示自动绘制的图形。  下面的代码由用户在ACAD图形中选择对象并将对象部分属性写入EXCEL文档。Sub WriteExcel()  Dim ExcelApp As New Excel.Application  Dim ExcelWkbk As Excel.Workbook  Set ExcelWkbk = ExcelAp

16、p.Workbooks.Add  Dim sel As AcadSelectionSet  Dim i As Integer  i = 2  On Error Resume Next  Set sel = ThisDrawing.SelectionSets.Add("ssel")  If Err T

17、hen    Err.Clear    Set sel = ThisDrawing.SelectionSets.Item("ssel")  End If  On Error GoTo 0  sel.SelectOnScreen  Dim Ent As AcadEntity  Dim pt1

18、 As Variant, pt2 As Variant  MsgBox ExcelWkbk.Name  With ExcelWkbk.Worksheets("sheet1")  For Each Ent In sel    Select Case UCase(Ent.ObjectName)     

19、 Case "ACDBLINE":        .Range("A" & i) = "直线"        pt1 = Ent.StartPoint        pt2 = Ent.End

20、Point        .Range("B" & i) = pt1(0)        .Range("c" & i) = pt1(1)        .Range("D" &

21、0;i) = pt2(0)        .Range("E" & i) = pt2(1)        i = i + 1      Case "ACDBCIRCLE":    &

22、#160;   .Range("A" & i) = "圆"        pt1 = Ent.Center        .Range("B" & i) = pt1(0)     &#

23、160;  .Range("C" & i) = pt1(1)        .Range("D" & i) = Ent.Radius        i = i + 1      Cas

24、e Else:    End Select  Next Ent  End With   "d:book1.xls"  ExcelApp.Workbooks.Close  ExcelApp.Quit  sel.DeleteEnd Sub  VBA读写EXCEL文档的一般方法与ACAD的VBA一样，MS EXCEL也提供ActiveX对象模型

25、，在ACAD VBA开发中使用EXCEL文档同样也要通过其ActiveX对象模型。详细介绍EXCEL的ActiveX对象模型恐怕离ACAD太远，也没有必要。在这只说说获取EXCEL工作表指定单元格内容的方法。与ACAD的ActiveX对象模型一样，EXCEL的ActiveX对象模型其顶层对象也是Application对象，EXCEL.Application对象提供的Workbooks工作簿集合对象包含有全部已经启动的EXCEL工作簿对象，我们可以使用Application对象的ActiveWorkbook方法来获取当前活动的工作簿对象，也可以使用Workbooks(Index)方法来

26、得到指定的工作簿对象。获取要操作的工作簿后，需要获取工作簿中的指定工作表(worksheet)才能访问到其中的指定单元格内容。EXCEL的单元格的确定由行和列唯一指定，例如Range("B4")表示第4行第2列。下面的代码从EXCEL文档中读出数据并在ACAD图形的模型空间中自动根据EXCEL文档内容绘图。行号是我加上的，真正的程序不需要它们。1    Sub ExcelRead()2       Dim ExcelApp As

27、0;New Excel.Application3        "d:book1.xls", , ReadOnly4       Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double5      

28、 Dim Rad As Double6       Dim i As Integer7       i = 28       With ExcelApp.ActiveWorkbook.Worksheets("sheet1")9   

29、0;   Do10        Select Case .Range("A" & i)11           Case "直线":12            

30、 pt1(0) = .Range("B" & i)13             pt1(1) = .Range("C" & i)14             pt1(2) = 

31、;015             pt2(0) = .Range("D" & i)16             pt2(1) = .Range("E" & i)17   &#

32、160;         pt2(0) = 018             pt1, pt219         Case "圆":20        

33、;    pt1(0) = .Range("B" & i)21            pt1(1) = .Range("C" & i)22            pt1(2) 

34、;= 023            Rad = .Range("D" & i)24            pt1, Rad25        Case Else:26 &#

35、160;          Exit Do27      End Select28      i = i + 129    Loop30    End With31    ExcelApp.

36、Workbooks.Close32    ExcelApp.Quit33    ThisDrawing.Application.Update34  End Sub运行这段代码需要加载EXCEL ActiveX对象模型。在ACAD VBA编辑器中选择“工具”菜单->“引用”，选择合适的Microsoft Excel Object Library。这段代码第2行先声明并新建一个EXCEL.Application对象。新建EXCEL对象

37、，也可以调用VB库函数CreateObject()：  Dim ExcelApp As Excel.Application   Set ExcelApp = CreateObject("Microsoft Excel")程序第3行调用EXCEL的Application对象的Workbooks集合的Open方法，以只读方式打开指定的EXCEL文档。第4-7行声明一些变量。i 用于表明要操作的EXCEL单元格的行号，通常EXCEL文档第1 

38、行是表头说明，我们从第2行开始读数据。程序第8行告诉编译程序以下对当前活动的EXCEL文档的Sheet1工作表进行操作。程序第9行到第29行循环读取EXCEL文档的Sheet1工作表中对于自动绘图有用的单元格内容并在ACAD模型空间中绘图。循环内部用Select Case语句根据EXCEL文档的第1 列内容选择不同的绘图方法。为了说明问题，程序仅对直线和圆两种ACAD图元对象进行操作并将其它对象出现作为循环退出条件。实际编程时可以对更多ACAD图元对象进行操作。程序第31、32行释放不再使用的EXCEL对象，第33行刷新ACAD图形以显示自动绘制的图形。 

39、0;下面的代码由用户在ACAD图形中选择对象并将对象部分属性写入EXCEL文档。Sub WriteExcel()  Dim ExcelApp As New Excel.Application  Dim ExcelWkbk As Excel.Workbook  Set ExcelWkbk = ExcelApp.Workbooks.Add  Dim sel As AcadSelec

40、tionSet  Dim i As Integer  i = 2  On Error Resume Next  Set sel = ThisDrawing.SelectionSets.Add("ssel")  If Err Then    Err.Clear    Se

41、t sel = ThisDrawing.SelectionSets.Item("ssel")  End If  On Error GoTo 0  sel.SelectOnScreen  Dim Ent As AcadEntity  Dim pt1 As Variant, pt2 As Variant 

42、0;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