VBA读写EXCEL文档的一般方法

leeyeafu

与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

gzy

看来李版主想普教众生，真是辛苦了，我谨代表我类菜鸟向您致敬！

该怎么办呢难哦

通过EXCEL表格数据来绘制图形不知在哪些方面得到过应用？哪位大侠应用过？我挺想知道的，谢谢

该怎么办呢难哦

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
我在EXCEL中输入数据后怎么在CAD中没有图线呀？

leeyeafu

复4楼：
你要在ACAD画线，应该调用读EXCEL的程序。

tukuitk

谢谢leeyeafu帮主！谢谢！！！

jennsen

太好了，我正需要这样的贴字，谢斑竹！

myfreemind

斑主辛苦了!

dzy7252

我用以下代码就是无法退出EXCEL,怎么办？？？
ExcelApp.ActiveWorkbook.SaveAs "d:\book1.xls"
  ExcelApp.Workbooks.Close
  ExcelApp.Quit
  sel.Delete

cwq

这程序输出到Excel的时候，怎么是空的？图快是肯定带属性的