[求助]请教高手：在AutoCAD VBA中怎么打开Excel文件？？

inxiu

我用通用对话框打开Excel文件，但是不知为何总出错，高手请指教！

Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
Dim ExcelName As String

    '设置标准对话框
    With comDlg
        .DialogTitle = "选择Excel文件"
        .Filter = "Excel文件(*.xls)|*.xls|所有文件(*.*)|*.*"
        .InitDir = "d:\my documents"
        .ShowOpen
    End With
   
    '文件类型错误的判断
    If Right(comDlg.FileName, 3) <> "xls" Then
        MsgBox "不支持的文件格式！", vbCritical, "警告"
        Exit Sub
    End If
   
    '打开文件的操作
    'Open comDlg.FileName For Input As #1

    'Close #1
   
    ExcelName = comDlg.FileName
    Excel.Workbooks.Open ExcelName

这样总有错误，说什么

Object variable or With block variable not set (Error 91)

我看了半天也没懂什么原因。

但是用以下代码就正确。

'*********************************************************************************

'错误处理
'On Error Resume Next
'Set Excel = GetObject(, "Excel.Application")
'If Err <> 0 Then
'Set Excel = CreateObject("Excel.Application")
'End If

 '打开excel表
 'ExcelName = InputBox("路径：")
 'Excel.Workbooks.Open ExcelName
'********************************************************************************

这样就是用了inputbox。但就是每次要打开excel文件就要手动输入文件名。太麻烦了。。。

请高手们指教！

兰州人

这两条语句是关键语句

Set Excel = GetObject(, "Excel.Application")

Set Excel = CreateObject("Excel.Application")
excel文件就要手动输入文件名。太麻烦了

你要达到什么目的?

inxiu

我要选择一个excel文件的数据，在autocad中根据数据画出图形来。

兰州人

看看我发的帖子，有专题描述，AutoCad二次开发教程有详细的介绍。

你最好发个示例，好给你讲解。

inxiu

这是具体的代码

是个画纵断面的程序，还有一个测试用的excel文件

inxiu

按照兰州人大哥的话

Set Excel = GetObject(, "Excel.Application")

Set Excel = CreateObject("Excel.Application")
这两句话我加上去了，貌似果然正常了。。。

afei21501

我也有类似疑问，不知道如何编程实现将EXCEL中的数据（坐标值，标高等）导入CAD中自动生成平面或者空间的单线图（轴线图，钢框架结构）

nhy12345678

我发个例子给你：

Sub clb() '画材料表
On Error GoTo err
Dim textObj As AcadText
Dim myselect(0 To 13) As AcadEntity
Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式
Dim d As Long
Dim p(0 To 2) As Double '插入点
Dim excelapp As Excel.Application '定义excle应用程序变量
Dim excelsheet As Worksheet '定义工作表变量
Dim p1 As Variant '申明端点坐标
Dim p2 As Variant '申明端点坐标
Dim i As Long
Dim x As Long
Dim y As Long
Dim a1(0 To 2) As Double
Dim a2(0 To 2) As Double
Dim pp(0 To 9) As Double '定义点坐标
Dim txt
Dim corow As Long
Dim attrtxt0 As String
Dim attrtxt00 As String
Dim attrtxt1 As String
Dim attrtxt2 As String
Dim attrtxt3 As String
Dim attrtxt4 As String
Dim attrtxt5 As String
Dim attrtxt6 As String
Dim attrtxt7 As String
Set excelapp = CreateObject("excel.application")  '激活excel程序
excelapp.Workbooks.Open (ThisDrawing.path & "/物料表.xls") '打开工作薄
Set excelsheet = excelapp.ActiveWorkbook.Sheets("sheet1") '当前工作表为sheet1
corow = excelsheet.UsedRange.Rows.Count '计算工作表的总行数

p1 = ThisDrawing.Utility.GetPoint(, "物料表图框左上角点:") '获取点坐标
p2 = ThisDrawing.Utility.GetPoint(, "物料表图框右上角点:") '获取点坐标
p1(0) = Int(p1(0))
p1(1) = Int(p1(1))
p2(0) = Int(p2(0))
p2(1) = Int(p2(1))
Call addlay("物料表", 3)
d = Sqr((p2(0) - p1(0)) ^ 2 + (p2(1) - p1(1)) ^ 2)
If d > 590 Then 'A2图框
pp(0) = p1(0) + 20: pp(1) = p1(1) - 39
pp(2) = p1(0) + 507: pp(3) = p1(1) - 39
pp(4) = p1(0) + 507: pp(5) = p1(1) - 379
pp(6) = p1(0) + 20: pp(7) = p1(1) - 379
pp(8) = p1(0) + 20: pp(9) = p1(1) - 39
Set myselect(1) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pp)
myselect(1).color = 4
End If
   a1(0) = p1(0) + 20: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 507: a2(1) = p1(1) - 76: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 40: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 40: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 62: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 62: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
      a1(0) = p1(0) + 97: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 97: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
      a1(0) = p1(0) + 117: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 117: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
      a1(0) = p1(0) + 147: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 147: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
         a1(0) = p1(0) + 184: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 184: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
         a1(0) = p1(0) + 219: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 219: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 258: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 258: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
  
   a1(0) = p1(0) + 269: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 269: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 289: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 289: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 311: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 311: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 346: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 346: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 366: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 366: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 396: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 396: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 433: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 433: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
   a1(0) = p1(0) + 463: a1(1) = p1(1) - 76: a1(2) = 0
   a2(0) = p1(0) + 463: a2(1) = p1(1) - 379: a2(2) = 0
   ThisDrawing.ModelSpace.AddLine a1, a2
x = p1(0) + 32: y = p1(1) - 93

   a1(0) = x - 12: a1(1) = y: a1(2) = 0
   a2(0) = x + 226: a2(1) = y: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)
   a1(0) = x + 237: a1(1) = y: a1(2) = 0
   a2(0) = x + 475: a2(1) = y: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)

For i = 1 To 25
   a1(0) = x - 12: a1(1) = y - i * 11: a1(2) = 0
   a2(0) = x + 226: a2(1) = y - i * 11: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)
myselect(1).color = 251
   a1(0) = x + 237: a1(1) = y - i * 11: a1(2) = 0
   a2(0) = x + 475: a2(1) = y - i * 11: a2(2) = 0
Set myselect(1) = ThisDrawing.ModelSpace.AddLine(a1, a2)
myselect(1).color = 251
Next i
Call addlay("文字标注", 3)
'-------------------------------------------------------
Set mytxt = ThisDrawing.TextStyles.Add("说明") '添加说明样式
mytxt.fontFile = "c:\windows\fonts\SIMHEI.TTF" '设置字体文件为仿宋体
mytxt.Height = 100 '字高
mytxt.Width = 0.8 '宽高比
ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
   a1(0) = x + 9: a1(1) = y + 29: a1(2) = 0
 attrtxt00 = excelsheet.Cells(2, 9).Value  '序号
 If corow > 52 Then
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt00 & "物 料 表 (一) ", a1, 10)
     txt.Alignment = acAlignmentLeft
 Else
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt00 & "物 料 表 ", a1, 10)
     txt.Alignment = acAlignmentLeft
 End If
   a1(0) = x - 2: a1(1) = y + 8.5: a1(2) = 0
 Set txt = ThisDrawing.ModelSpace.AddText("类别", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
    a1(0) = x + 19: a1(1) = y + 8.5: a1(2) = 0
 Set txt = ThisDrawing.ModelSpace.AddText("代号", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 47: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("材料名称", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
    
     a1(0) = x + 75: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("品牌", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
    
     a1(0) = x + 100: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("规格型号", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 133: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("电话", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 169: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("部位", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 206: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("工艺要求", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
    
   a1(0) = x + 247: a1(1) = y + 8.5: a1(2) = 0
 Set txt = ThisDrawing.ModelSpace.AddText("类别", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
    a1(0) = x + 268: a1(1) = y + 8.5: a1(2) = 0
 Set txt = ThisDrawing.ModelSpace.AddText("代号", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 296.5: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("材料名称", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
    
     a1(0) = x + 324: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("品牌", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
    
     a1(0) = x + 349: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("规格型号", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 382: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("电话", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 416: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("部位", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     a1(0) = x + 452: a1(1) = y + 8.5: a1(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText("工艺要求", a1, 5)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
 '--------------------------------------------------------

For i = 1 To 26

  attrtxt0 = excelsheet.Cells(i + 1, 1).Value '类别
  attrtxt1 = excelsheet.Cells(i + 1, 2).Value '代号
  attrtxt2 = excelsheet.Cells(i + 1, 3).Value '材料名称
  attrtxt3 = excelsheet.Cells(i + 1, 4).Value '品牌
  attrtxt4 = excelsheet.Cells(i + 1, 5).Value '型号
  attrtxt5 = excelsheet.Cells(i + 1, 6).Value '电话
  attrtxt6 = excelsheet.Cells(i + 1, 7).Value '部位
  attrtxt7 = excelsheet.Cells(i + 1, 8).Value '工艺要求
  a1(0) = x - 2
  a1(1) = y - 5.5 - (i - 1) * 11
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt0, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 19
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt1, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 47
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt2, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 75
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt3, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 100
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt4, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 133
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt5, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
      a1(0) = x + 169
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt6, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 206
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt7, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
Next i
'-------------------------------------------------------'
If corow > 26 Then
  For i = 27 To 52

  attrtxt0 = excelsheet.Cells(i + 1, 1).Value '类别
  attrtxt1 = excelsheet.Cells(i + 1, 2).Value '代号
  attrtxt2 = excelsheet.Cells(i + 1, 3).Value '材料名称
  attrtxt3 = excelsheet.Cells(i + 1, 4).Value '品牌
  attrtxt4 = excelsheet.Cells(i + 1, 5).Value '型号
  attrtxt5 = excelsheet.Cells(i + 1, 6).Value '电话
  attrtxt6 = excelsheet.Cells(i + 1, 7).Value '部位
  attrtxt7 = excelsheet.Cells(i + 1, 8).Value '工艺要求
  a1(0) = x + 247
  a1(1) = y - 5.5 - (i - 27) * 11
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt0, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 268
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt1, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 296.5
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt2, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 324
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt3, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 349
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt4, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 382
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt5, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
      a1(0) = x + 416
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt6, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
  a1(0) = x + 452
 Set txt = ThisDrawing.ModelSpace.AddText(attrtxt7, a1, 4)
     txt.Alignment = acAlignmentMiddleCenter
     txt.TextAlignmentPoint = a1
     Next i
End If

err:
excelapp.Quit '退出excel程序
Set excelapp = Nothing '释放变量
Set excelsheet = Nothing
End Sub