|
试下以下删除属性的代码
Const HeaderRow = 2 '表头列
Const PropLeft = 4 '属性名称左端栏位
Sub DeleteProps()
yn = MsgBox("Once Deleted, those cannot be restored. Continue?", vbYesNo)
If yn <> 6 Then Exit Sub
Set swApp = CreateObject("SldWorks.Application")
RowNumber = HeaderRow + 1
PathName = Cells(RowNumber, 1) & "" '读取第一个路径的值
While Not (PathName = "")'直到读完路径栏
FileName = Cells(RowNumber, 2)
FileExtname = UCase(Right(Cells(RowNumber, 2), 6))
If "SLDPRT" = FileExtname Then swFileTYpe = 1
If "SLDASM" = FileExtname Then swFileTYpe = 2
If "SLDDRW" = FileExtname Then swFileTYpe = 3
If "SLDLFP" = FileExtname Then swFileTYpe = 1
If Not (swFileTYpe = 3 And FileName = Cells(RowNumber - 1, 2)) Then
Set swDoc = swApp.OpenDoc(PathName & FileName, swFileTYpe) '开启档案
ColumnNumber = PropLeft
PropName = Cells(HeaderRow, ColumnNumber) & ""
While Not (PropName = "")'直到读完表头
If Not (Left(PropName, 1) = "$" And Right(PropName, 1) = "$") Then
swDoc.DeleteCustomInfo2 Cells(RowNumber, 3), PropName
End If
ColumnNumber = ColumnNumber + 1 '下一栏
PropName = Cells(HeaderRow, ColumnNumber)
Wend '回到>直到读完表头
Cells(RowNumber, 1).Interior.Color = RGB(255, 50, 50)
Else
Cells(RowNumber, 1).Interior.Pattern = xlNoneColor
End If
RowNumber = RowNumber + 1 '下一列
PathName = Cells(RowNumber, 1) & ""
Wend '回到>直到读完路径栏
End Sub
复制代码 |
|