注册 登录
编程论坛 Excel/VBA论坛

各位老师,帮忙给看看是哪里的问题

WhistleMan 发布于 2021-02-19 22:16, 2890 次点击
老师,您好:
    我在CAD中加入了个VB,想要实现一个批量操作,但是一直没成功,麻烦各位老师给看下哪个地方有问题。
只有本站会员才能查看附件,请 登录

代码如下:
程序代码:

Sub ChangeDrawingNumb()
   Dim curFileName As String
   Dim curFileName1 As String
   Dim changeResult As String
   Dim objPath As String
   Dim objName As String
   Dim objBlkName As String
   Dim lyName As String
   Dim xlApp As Excel.Application
   Dim xlsheet As Excel.Worksheet
   Dim dwgInfo(0 To 9) As String
   Dim i As Integer
   Dim h As Integer
   Dim xlspath As String
   objBlkName = "TUHAO"
   curFileName = openfile
   curFileName1 = curFileName
   n = 0
   For i = 1 To Len(curFileName1)
   If (Mid$(curFileName1, i, 1) = "\") Then '修改路径
   Mid$(curFileName1, i, 1) = "/"
   n = i
   End If
   Next i
   xlspath = Left(curFileName1, n)
   objPath = Path(xlspath)
   UserForm1.show
   On Error Resume Next
   Set xlApp = GetObject(, "excel. application")
   If Err <> 0 Then
   Set xlApp = CreateObject("excel. application")
   End If
   xlApp.Visible = True
   xlApp.Workbooks.Open curFileName
   If Left(Err.Description, 4) = " 无法找到 " Then
   MsgBox Err.Description
   End
   ElseIf Err.Description = " 应用程序定义或对象定义错误 " Then
   xlApp.Workbooks(objName).Activate
   End If
   Set xlsheet = xlApp.ActiveWorkbook.Worksheets("sheet1")
   dwgInfo(0) = xlsheet.Cells(1, 1).Offset(1, 0) 'CAD 文件名初使化
   n = 0
   h = 0
   With xlsheet.Cells(1, 1)
   While dwgInfo(0) <> "" 'Len(dwgInfo(0))<= 3
   h = h + 1
   i = 0
   dwgInfo(0) = .Offset(h, i)
   For i = 1 To 9
   dwgInfo(i) = .Offset(h, i)
   Next i
   ' 匹配文件定义为   驱动器 :\ 目录 \*站号 *.dwg  格式
   curFileName = objPath + "*" + dwgInfo(0) + "*.dwg" ' 检查文件 _dwginfo(0) 是否空文件
   If dwgInfo(0) <> "" Then ' 检查是否找到指定文件,若找到 则进行查找修改,否则标注无匹配文件
   If Len(Dir(curFileName)) > 0 Then
   curFileName = objPath + Dir(curFileName) ' 在 cad 中打开 dwg 文件 _ dwginfo(0)
   AutoCAD.Documents.Open curFileName ' 修改 TuHao 块值
   changeResult = ChangeAtt(objBlkName, dwgInfo(1), dwgInfo(2), dwgInfo(3), dwgInfo(4), dwgInfo(5), dwgInfo(6), dwgInfo(7), dwgInfo(8), dwgInfo(9))
   .Offset(h, 10).Value = changeResult
   ZoomAll
   ThisDrawing.Save
   ThisDrawing.Close
   n = n + 1
   Else
   changeResult = " 此目录下没有相匹配的CAD文件"
   .Offset(h, 10).Value = changeResult
   End If
   End If
   Wend
   End With
   MsgBox " 修改图号完毕,您共修改了" & n & " 个图文件"
   Set xlsheet = Nothing
   Set xlApp = Nothing
End Sub



谢谢各位大佬

[此贴子已经被作者于2021-2-19 22:17编辑过]

4 回复
#2
HVB62021-03-04 16:41
回复 楼主 WhistleMan
objPath = Path(xlspath)不是vba函数当然出错。
#3
WhistleMan2021-03-15 15:07
回复 2楼 HVB6
那大佬这个程序应该怎么改啊,纯小白,代码是搬过来的
#4
HVB62021-03-15 22:44
回复 3楼 WhistleMan
objPath = Path(xlspath)改为objPath = xlspath试试。
#5
akl2021-09-15 08:38
回复 楼主 WhistleMan
哥们,最后调试成功了吗?怎么修改的?
1