VBA代码隐藏不需要的图层
以下是用在中望CAD的VBA代码,用于实现隐藏不需要的图层,程序能正常运行,但是无法隐藏指定的图层,求大神指点Option Explicit
Sub XXX()
Application.ScreenUpdating = False '
Dim password As Variant
password = ThisWorkbook.Sheets("INPUT").Range("P2")
If password = "369" Then
Dim ZcadApp As ZcadApplication
Dim ZcadDoc As ZcadDocument
With ThisWorkbook.Sheets("Input")
If .Range("S8") <> "调试" Then
Dim wjmc As String
If .Range("S7") = "当前文件夹" Then
wjmc = ThisWorkbook.Path & "\" & .Range("S4") & ".dwg"
Else
wjmc = .Range("S7") & "\" & .Range("S4") & ".dwg"
End If
FileCopy .Range("S6") & "\" & .Range("S5") & ".dwg", wjmc
End If
On Error Resume Next '判断语句是否出错
Set ZcadApp = GetObject(, "ZWcad.application")
If Err Then
Err.Clear
Set ZcadApp = CreateObject("ZWcad.application")
If Err Then
MsgBox Err.Description'报错
Exit Sub
End If
End If
ZcadApp.Visible = True '
ZcadApp.WindowState = zcMax
If .Range("S8") <> "调试" Then
ZcadApp.Documents.Open wjmc
Else
ZcadApp.Documents.Open .Range("S6") & "\" & .Range("S5") & ".dwg"
End If
Set ZcadDoc = ZcadApp.ActiveDocument
Dim mxzdyd As String, mxzded As String, mcd As String, ncd As String
Dim i As Integer, n As Integer, mbgzb As String
Dim m As Integer
mbgzb = .Range("S5")
End With
With ThisWorkbook.Sheets(mbgzb)
Dim dz1 As ZcadLayer '隐藏图层
n = .Range("AC65536").End(xlUp).Row
For i = 3 To n
Set dz1 = ZcadDoc.Layers(.Range("AC" & i))
dz1.LayerOn = .Range("AD" & i)
End With
Set ZcadApp = Nothing
Set ZcadDoc = Nothing
End If
Application.ScreenUpdating = True
End Sub
把On Error Resume Next去掉再调试吧,.Range("AC65536").End(xlUp).Row这样的语句有太多不确定因素,建议先计算行数,并且控制好范围 dz1.LayerOn = .Range("AD" & i)
调试检查一下你这句右边的值的类型对不对 这个类型并不是布尔,你这个返回的应该是类,dz1.LayerOn这属性要的是布尔类型的值
页:
[1]