mikefeng 发表于 2005-2-1 17:31:00

读取数据

如何用vba 读取excel中数据

wmz 发表于 2005-2-3 11:50:00

mikefeng发表于2005-2-1 17:31:00static/image/common/back.gif回复：（mikefeng）读取数据如何用vba 读取excel中数据

<BR>Sub dsj()<BR>               Dim Dlg As New CommonDialog<BR>               Set hExcel = CreateObject("Excel.Application")<BR>                       hExcel.Visible = False<BR>               Dim dyg As String,dmh(100) as String, i as integer,n As integer<BR>       If sheet = "" Then<BR>                               Dlg.Filter = "Excel工作簿文件*.XLS|*.XLS|所有文件*.*|*.*"<BR>                               Dlg.ShowOpen<BR>                               sheet = Dlg.filename<BR>       End If<BR>                               hExcel.Workbooks.Open (sheet), False<BR>                               n=100<BR>                       for i=1 to n<BR>                                               dyg = "A" &amp; Cstr(i)<BR>                                               dmh = hExcel.Range(dyg).Text<BR>                       next i<BR>                       hExcel.Quit<BR>End Sub

mikefeng 发表于 2005-2-3 11:51:00

非常感谢

cqy 发表于 2005-2-3 16:12:00

网上有CAD与EXCEL通信源码

mikefeng 发表于 2005-2-4 10:36:00

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

cqy 发表于 2005-2-4 13:56:00

For bEach       blkElem       In       ThisDrawing.ModelSpace


改为：


        For Each       blkElem       In       ThisDrawing.ModelSpace


程序可用。


<BR>

mikefeng 发表于 2005-2-4 14:20:00

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

cqy 发表于 2005-2-4 14:47:00

<b><FONT color=#0000ff size=5>利用VBA 建立AutoCad2000与Excel通信</FONT></b>


<FONT size=3>Sub       BlkAttr_Extract()<BR>                       Dim       Excel       As       Excel.Application<BR>                       Dim       ExcelSheet       As       Object<BR>                       Dim       ExcelWorkbook       As       Object<BR>                       '创建Excel应用程序实例<BR>                       On       Error       Resume       Next<BR>                       Set       Excel = GetObject(, "Excel.Application")<BR>                       If       Err &lt;&gt; 0       Then<BR>                                                       Set       Excel = CreateObject("Excel.Application")<BR>                       End       If<BR>                       '创建一个新工作簿<BR>                       Set       ExcelWorkbook = Excel.Workbooks.Add<BR>                       '确保Sheet1工作表为当前工作表<BR>                       Set       ExcelSheet = Excel.ActiveSheet<BR>                       '将新创建的工作簿保存为Excel文件<BR>                       ExcelWorkbook.SaveAs "属性表.xls"<BR>                       '令Excel应用程序可见<BR>                       Dim       RowNum       As       Integer<BR>                       Dim       Header       As       Boolean<BR>                       Dim       blkElem       As       AcadEntity<BR>                       Dim       Array1       As       Variant<BR>                       Dim       Count       As       Integer<BR>                       RowNum = 1<BR>                       Header = False<BR>                       '遍历模型空间，查找明细表的每个块引用表行<BR>                       For bEach       blkElem       In       ThisDrawing.ModelSpace<BR>                                                       With       blkElem<BR>                                                                                       '当一个块引用表行被找到后，检查它是否有属性<BR>                                                                                       If       StrComp(.EntityName, "AcDbBlockReference", 1) = 0       Then<BR>                                                                                                                       '如果有属性<BR>                                                                                                                       If . HasAttributes       Then<BR>                                                                                                                                                       '提取块引用中的属性<BR>                                                                                                                                                       Array1 = .GetAttributes<BR>                                                                                                                                                       '这一轮循环用来查找标题，如果有填在第1行<BR>                                                                                                                                                       For       Count = LBound(Array1)       To       UBound(Array1)<BR>                                                                                                                                                                                       '如果还没有标题<BR>                                                                                                                                                                                       If       Header = False       Then<BR>                                                                                                                                                                                                                       '作为标题的明细行其块属性常设为Constant类型<BR>                                                                                                                                                                                                                       If       Array1(Count).Constant       Then<BR>                                                                                                                                                                                                                                                       ExcelSheet.Cells(RowNum, Count + 1).Value _<BR>                                                                                                                                                                                                                                                                                                                                                                                       = Array1(Count).TextString<BR>                                                                                                                                                                                                                       End       If<BR>                                                                                                                                                                                       End       If<BR>                                                                                                                                                       Next       Count<BR>                                                                                                                                                       '从第2行开始，填写其它的明细表行内容<BR>                                                                                                                                                       RowNum = RowNum + 1<BR>                                                                                                                                                       For       Count = LBound(Array1)       To       UBound(Array1)<BR>                                                                                                                                                                                       ExcelSheet.Cells(RowNum, Count + 1).Value _<BR>                                                                                                                                                                                                                                                                                       = Array1(Count).TextString<BR>                                                                                                                                                       Next       Count<BR>                                                                                                                                                       Header = True<BR>                                                                                                                       End       If<BR>                                                                                       End       If<BR>                                                       End       With<BR>                       Next       blkElem<BR>                       '对填入当前表单的内容，按第1列进行排序,<BR>                       '范围是从A1单元格开始的整个工作表<BR>                       Excel.Worksheets("Sheet1").Range("A1").Sort _<BR>                                                       key1:=Excel.Worksheets("Sheet1").Columns("A"), _<BR>                                                       Header:=xlGuess<BR>                       '显示Excel工作表中的结果<BR>                       Excel.Visible = True<BR>                       '该语句用来等待查看显示结果<BR>                       MsgBox "按‘确定’键将关闭Excel的运行！"<BR>                       '保存传过来的数据<BR>                       ExcelWorkbook.Save<BR>                       '关闭Excel应用程序<BR>                       Excel.Application.Quit<BR>                       '删除Excel应用程序实例<BR>                       Set Excel = Nothing<BR>End Sub</FONT>

mikefeng 发表于 2005-2-7 09:14:00

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

laoliu09 发表于 2005-2-7 11:20:00

我是忙着加班啊！55555，春节加班啊！55555！还要画图啊！55555！幸亏我有了自己定制的cad，呵呵！画图简单了！哈哈哈！
页: [1] 2
查看完整版本: 读取数据