读取数据

mikefeng

如何用vba 读取excel中数据

wmz

mikefeng发表于2005-2-1 17:31:00回复：（mikefeng）读取数据如何用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

mikefeng

非常感谢

cqy

网上有CAD与EXCEL通信源码

mikefeng

该程序在运行中好象有点问题

cqy

For bEach blkElem In ThisDrawing.ModelSpace 改为： For Each blkElem In ThisDrawing.ModelSpace 程序可用。

mikefeng

各位高人 在指点迷津时能否更详细一点 请不要悯惜笔墨

cqy

利用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 Err <> 0 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

mikefeng

近日比较冷清 是不是忙着过年了

laoliu09

我是忙着加班啊！55555，春节加班啊！55555！还要画图啊！55555！幸亏我有了自己定制的cad，呵呵！画图简单了！哈哈哈！