读取数据
如何用vba 读取excel中数据Sub dsj()
Dim Dlg As New CommonDialog
Set hExcel = CreateObject("Excel.Application")
hExcel.Visible = False
Dim dyg As String,dmh(100) as String, i as integer,n As integer
If sheet = "" Then
Dlg.Filter = "Excel工作簿文件*.XLS|*.XLS|所有文件*.*|*.*"
Dlg.ShowOpen
sheet = Dlg.filename
End If
hExcel.Workbooks.Open (sheet), False
n=100
for i=1 to n
dyg = "A" & Cstr(i)
dmh = hExcel.Range(dyg).Text
next i
hExcel.Quit
End Sub 非常感谢 网上有CAD与EXCEL通信源码 该程序在运行中好象有点问题 For bEach blkElem In ThisDrawing.ModelSpace
改为：
For Each blkElem In ThisDrawing.ModelSpace
程序可用。
各位高人 在指点迷津时能否更详细一点 请不要悯惜笔墨 利用VBA 建立AutoCad2000与Excel通信
Sub BlkAttr_Extract()
Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
'创建Excel应用程序实例
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err0 Then
Set Excel = CreateObject("Excel.Application")
End If
'创建一个新工作簿
Set ExcelWorkbook = Excel.Workbooks.Add
'确保Sheet1工作表为当前工作表
Set ExcelSheet = Excel.ActiveSheet
'将新创建的工作簿保存为Excel文件
ExcelWorkbook.SaveAs "属性表.xls"
'令Excel应用程序可见
Dim RowNum As Integer
Dim Header As Boolean
Dim blkElem As AcadEntity
Dim Array1 As Variant
Dim Count As Integer
RowNum = 1
Header = False
'遍历模型空间，查找明细表的每个块引用表行
For bEach blkElem In ThisDrawing.ModelSpace
With blkElem
'当一个块引用表行被找到后，检查它是否有属性
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
'如果有属性
If . HasAttributes Then
'提取块引用中的属性
Array1 = .GetAttributes
'这一轮循环用来查找标题，如果有填在第1行
For Count = LBound(Array1) To UBound(Array1)
'如果还没有标题
If Header = False Then
'作为标题的明细行其块属性常设为Constant类型
If Array1(Count).Constant Then
ExcelSheet.Cells(RowNum, Count + 1).Value _
= Array1(Count).TextString
End If
End If
Next Count
'从第2行开始，填写其它的明细表行内容
RowNum = RowNum + 1
For Count = LBound(Array1) To UBound(Array1)
ExcelSheet.Cells(RowNum, Count + 1).Value _
= Array1(Count).TextString
Next Count
Header = True
End If
End If
End With
Next blkElem
'对填入当前表单的内容，按第1列进行排序,
'范围是从A1单元格开始的整个工作表
Excel.Worksheets("Sheet1").Range("A1").Sort _
key1:=Excel.Worksheets("Sheet1").Columns("A"), _
Header:=xlGuess
'显示Excel工作表中的结果
Excel.Visible = True
'该语句用来等待查看显示结果
MsgBox "按‘确定’键将关闭Excel的运行！"
'保存传过来的数据
ExcelWorkbook.Save
'关闭Excel应用程序
Excel.Application.Quit
'删除Excel应用程序实例
Set Excel = Nothing
End Sub 近日比较冷清 是不是忙着过年了 我是忙着加班啊！55555，春节加班啊！55555！还要画图啊！55555！幸亏我有了自己定制的cad，呵呵！画图简单了！哈哈哈！
页:
[1]