select case形式的过滤器，数据用外部文件输入，内部编程用一个变量参数？？
1:主程序调试成功的Sub getvalves()
Dim cName As String
Dim nHandle As String
Dim nScale As Double
Dim nRotation As Double
Dim sLayer As String
Dim yline As Integer
Dim ent As Object
Dim obname As String
Dim xy As Variant
Dim varattr As Variant
Dim attrtxt As Variant
Dim varAttributes As Variant
On Error Resume Next
Dim Excel As Object
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
'创建Excel应用程序实例
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
Set ExcelSheet = Excel.ActiveSheet
Excel.Visible = True
'''''''''''''
If ExcelSheet.cells(1, 1).Value = "" Then
ExcelSheet.cells(1, 1).Value = "块名称"
ExcelSheet.cells(1, 2).Value = "阀名称"
ExcelSheet.cells(1, 3).Value = "尺寸"
ExcelSheet.cells(1, 4).Value = "等级"
ExcelSheet.cells(1, 5).Value = "数量"
ExcelSheet.cells(1, 6).Value = "（配套法兰数量）"
ExcelSheet.Range("A1:F1").Characters.Font.FontStyle = "加粗"
yline = 2 '写入行位置
'ExcelSheet.Cells(1, 7).Value = yline
Else
yline = ExcelSheet.UsedRange.Rows.Count + 1
' ExcelSheet.Cells(2, 8).Value = yline
End If
'''''''''''''''''''
For Each ent In ThisDrawing.ModelSpace '在模型空间里循环
obname = ent.ObjectName '提取对象类型
If obname = "AcDbBlockReference" Then '判断对象是否为块
cName = ent.Name '获取块名
varAttributes = ent.GetAttributes
xy = ent.InsertionPoint '获取插入点坐标
nHandle = ent.Handle '获取块句柄
nScale = ent.XScaleFactor '获取比例
nRotation = ent.Rotation '获取角度
sLayer = ent.Layer
varattr = ent.GetAttributes ' 将块属性标记和值复制到varattr变量
attrtxt(0) = varattr(0).TextString '属性值 0
attrtxt(1) = varattr(1).TextString '属性值 1
attrtxt(2) = varattr(2).TextString '属性值 2
On Error Resume Next
'''''''''''''''''''''''''''''''''
'ExcelSheet.Range("a:a").Visible = False '自动隐藏A列
Select Case cName
Case "ABAV1-C"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "Ball valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "flg-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 2
ExcelSheet.cells(yline, 6).Value = 0
Case "abav1-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "Ball valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "abav2-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "Closed ball valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "abav3-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "ball valve with 2 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 2
Case "abav4-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "Closed ball valve with 2 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 2
Case "achv1-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "check valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "achv2-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "check valve with 2 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 2
Case "ACHV-C"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "check valve with 1 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 1
Case "acov3-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "presure regulator"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "agav1-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "gate valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "agav2-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "closed gate valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "aglv2-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "closed globle valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "aglv4-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "closed globle valve with 2 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 2
Case "aglv8-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "closed globle valve with 1 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 1
Case "apsv1-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "pressure relief valve with 2 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 2
Case "APSV2-C"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "pressure relief valve with 2 flange"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 2
Case "asdv2-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "hydraulic/pneumatic operated valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "bnev-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "needle valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
'ExcelSheet.Cells(yline, 4).Value = varAttributes(0).TextString
Case "bstw-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "three way solenoid valve"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "dplug-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "pluge"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case "conr-c"
ExcelSheet.cells(yline, 1).Value = cName
ExcelSheet.cells(yline, 2).Value = "reducer"
ExcelSheet.cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.cells(yline, 5).Value = 1
ExcelSheet.cells(yline, 6).Value = 0
Case Else
yline = yline - 1
End Select
'''''''''''''''''''''''''''''''''''''''''''
yline = yline + 1 '位置加一行
On Error Resume Next
End If
On Error Resume Next
Next
ExcelSheet.Range("b:b").entirecolumn.AutoFit '自动调整当前工作表A列的列宽
ExcelSheet.Range("F:F").entirecolumn.AutoFit '自动调整当前工作表A列的列宽
'ExcelSheet.cells(2, 2).FreezePanes = True '自动冻结A列
ExcelSheet.Rows(2).Select
Excel.ActiveWindow.FreezePanes = True
ExcelSheet.cells(2, 10).Select
'ExcelSheet.Columns("a:a").Entirecolumn.Hidden = True '自动隐藏A列
Excel.Visible = True
On Error Resume Next
Set Excel = Nothing '释放变量
On Error Resume Next
Set ExcelSheet = Nothing
On Error Resume Next
End Sub
2：excel文件读入cad测试成功的
Public Sub exceltocad1()'读取索引文件，块名和管件名称ByRef bname
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim strFileName As String
Dim ObjectCount As Long'存储索引文件的数量，行数
Dim bname()
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
If Err.Number <> 0 Then
Err.Clear
MsgBox "Excel软件没有正确打开。", vbOKOnly + 16, "提示："
Exit Sub
End If
strFileName = InputBox("输入管件索引数据路径\ *.xls）.", "打开文件：")
If Dir(strFileName) = "" Then
MsgBox "文件未找到。"
Exit Sub
End If
Set xlBook = xlApp.Workbooks.Open(strFileName)
Set xlSheet = xlBook.Worksheets(1)
ObjectCount = xlSheet.UsedRange.Rows.Count '获取A列最后一个单元格的行数
'Dim blockname(), fittingsname() '开头定义了
ReDim bname(ObjectCount - 1, 2)
bname = xlSheet. '区域赋值给二位数组
'exceltocad = bname
MsgBox bname(1, 2)
xlBook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
'MsgBox "加载成功"
End Sub
3： 想把程序1中 select case语句 用一个循环搞定，
case的每一个值用excel文本读入，如下形式
Dim i
For i = 0 To ObjectCount - 2
Select Case cName
Case blockname(i)
ExcelSheet.Cells(yline, 1).Value = cName
ExcelSheet.Cells(yline, 2).Value = fittingsname(i)
ExcelSheet.Cells(yline, 3).Value = Split(varAttributes(0).TextString, "-")(0) '管线号拆分取尺寸
ExcelSheet.Cells(yline, 4).Value = Split(varAttributes(0).TextString, "-")(3) '管线号拆分取等级
ExcelSheet.Cells(yline, 5).Value = quantity(i)
Case Else
yline = yline - 1
End Select
4：求解，我一直没调试成功？？？？？？？？？？？？？？？？？？
此程序目的是——以外部excel文档给的 blockname（块名称），为case过滤器条件，讲当中这个块全部选择出来，并输入一个新的excel文档中，
新的文档中包含：blockname、fittingsname、等五项
表述不清？关键代码不全？
逐句调试吧
页:
[1]