Warning: file_get_contents(/data/phpspider/zhask/data//catemap/1/ms-access/4.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Ms access MS Access查询列隐藏属性_Ms Access_Vba - Fatal编程技术网

Ms access MS Access查询列隐藏属性

Ms access MS Access查询列隐藏属性,ms-access,vba,Ms Access,Vba,我编写了一些VBA代码,它(a)基于输入变量设置查询的SQL,(b)在数据表视图中打开查询,以及(c)基于另一个表中复选框的“true”/“false”值隐藏或显示列。这将考虑Microsoft开发中心帮助中描述的“ColumnHidden”属性 执行代码时,(a)和(b)按预期工作。然而,在执行(c)时,我在第fld.Properties(“ColumnHidden”)行得到错误3270,“Property not found”。我一直无法解决这个问题,甚至在尝试开发中心描述的错误处理方法时也

我编写了一些VBA代码,它(a)基于输入变量设置查询的SQL,(b)在数据表视图中打开查询,以及(c)基于另一个表中复选框的“true”/“false”值隐藏或显示列。这将考虑Microsoft开发中心帮助中描述的“ColumnHidden”属性

执行代码时,(a)和(b)按预期工作。然而,在执行(c)时,我在第
fld.Properties(“ColumnHidden”)行得到错误3270,“Property not found”。我一直无法解决这个问题,甚至在尝试开发中心描述的错误处理方法时也是如此。请帮忙

Dim rsLabel As DAO.Recordset, rsCOlumn As DAO.Recordset
Dim qryCPQ As DAO.QueryDef
Dim strLabel As String, strSQL As String, strColumn As String
Dim fld As DAO.Field
Dim dbs As DAO.Database
Dim prp As DAO.Property
Dim AttArray As Variant
Dim x As Integer


ReDim AttArray(19, 1)
For x = 1 To 20
    AttArray(x - 1, 1) = "Att" & x
Next x

strLabel = "SELECT * FROM PM_qryLabels2 WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily
Set rsLabel = CurrentDb.OpenRecordset(strLabel, dbOpenSnapshot)
rsLabel.MoveFirst

For x = 1 To 20
    If Not IsNull(rsLabel.Fields("Att" & x)) Then
        AttArray(x - 1, 1) = rsLabel.Fields("Att" & x)
    Else
        AttArray(x - 1, 1) = "Att" & x
    End If
Next x


With CurrentDb
    Set qryCPQ = .QueryDefs("CM_qryCollectionReport")

    strSQL = "SELECT CM_qryCollectionEdit2.CATEGORY, CM_qryCollectionEdit2.Part_No, CM_qryCollectionEdit2.CPQ_Material, CM_qryCollectionEdit2.CPQ_LaborMach, CM_qryCollectionEdit2.CPQ_LaborAssy, CM_qryCollectionEdit2.CPQ_LaborPipe, CM_qryCollectionEdit2.CPQ_LaborTest, CM_qryCollectionEdit2.CPQ_LaborPack, CM_qryCollectionEdit2.CPQ_LaborShip, CM_qryCollectionEdit2.CPQ_Sub, " & _
             "PM_qryOptions.Att1 As [" & AttArray(0, 1) & "], PM_qryOptions.Att2 As [" & AttArray(1, 1) & "], PM_qryOptions.Att3 As [" & AttArray(2, 1) & "], PM_qryOptions.Att4 As [" & AttArray(3, 1) & "], PM_qryOptions.Att5 As [" & AttArray(4, 1) & "], PM_qryOptions.Att6 As [" & AttArray(5, 1) & "], PM_qryOptions.Att7 As [" & AttArray(6, 1) & "], PM_qryOptions.Att8 As [" & AttArray(7, 1) & "], PM_qryOptions.Att9 As [" & AttArray(8, 1) & "], PM_qryOptions.Att10 As [" & AttArray(9, 1) & "], PM_qryOptions.Att11 As [" & AttArray(10, 1) & "], PM_qryOptions.Att12 As [" & AttArray(11, 1) & "], PM_qryOptions.Att13 As [" & AttArray(12, 1) & "], PM_qryOptions.Att14 As [" & AttArray(13, 1) & "], PM_qryOptions.Att15 As [" & AttArray(14, 1) & "], PM_qryOptions.Att16 As [" & AttArray(15, 1) & "], PM_qryOptions.Att17 As [" & AttArray(16, 1) & "], PM_qryOptions.Att18 As [" & AttArray(17, 1) & "], PM_qryOptions.Att19 As [" & AttArray(18, 1) & "], PM_qryOptions.Att20 As [" & AttArray(19, 1) & "] " & _
             "FROM CM_qryCollectionEdit2 INNER JOIN PM_qryOptions ON CM_qryCollectionEdit2.Part_No = PM_qryOptions.Part_No " & _
             "WHERE ((CM_qryCollectionEdit2.CAT_ID)=" & Me.cboFamily & " AND ((CM_qryCollectionEdit2.CPQ_Publish)=True));"
    qryCPQ.SQL = strSQL
    qryCPQ.Close
    Set qryCPQ = Nothing
End With

DoCmd.OpenQuery "CM_qryCollectionReport", , acReadOnly

Set dbs = CurrentDb

For x = 1 To 20
    Set fld = dbs.QueryDefs!CM_qryCollectionReport.Fields(AttArray(x - 1, 1))
    fld.Properties("ColumnHidden") = False

    strColumn = "SELECT * FROM PM_Attributes WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily & " AND [ATTRIBUTE]='" & AttArray(x - 1, 1) & "'"
    Set rsCOlumn = CurrentDb.OpenRecordset(strColumn, dbOpenSnapshot)

    If Not rsCOlumn.EOF Then
        If rsCOlumn![CPQ_Publish] = False Then
            fld.Properties("ColumnHidden") = True
        End If
    End If

    rsCOlumn.Close
    Set rsCOlumn = Nothing
    Set fld = Nothing
Next x


Set dbs = Nothing

DoCmd.Close acForm, "CM_frmCollectionReportPre", acSaveNo
根据Eric Von Asmuth的建议,我在错误处理中添加了代码,因此代码现在显示如下。但我仍然在同一位置收到错误3270。什么都没修好

Dim rsLabel As DAO.Recordset, rsCOlumn As DAO.Recordset
Dim qryCPQ As DAO.QueryDef
Dim strLabel As String, strSQL As String, strColumn As String
Dim fld As DAO.Field
Dim dbs As DAO.Database
Dim prp As DAO.Property
Dim AttArray As Variant
Dim x As Integer
Const conErrPropertyNotFound = 3270

' Turn off error trapping
On Error Resume Next

ReDim AttArray(19, 1)
For x = 1 To 20
    AttArray(x - 1, 1) = "Att" & x
Next x

strLabel = "SELECT * FROM PM_qryLabels2 WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily
Set rsLabel = CurrentDb.OpenRecordset(strLabel, dbOpenSnapshot)
rsLabel.MoveFirst

For x = 1 To 20
    If Not IsNull(rsLabel.Fields("Att" & x)) Then
        AttArray(x - 1, 1) = rsLabel.Fields("Att" & x)
    Else
        AttArray(x - 1, 1) = "Att" & x
    End If
Next x

'AFTER FORM IS OPEN, NEED TO HIDE COLUMNS BASEDON CPQ_PUBLISH

With CurrentDb
    Set qryCPQ = .QueryDefs("CM_qryCollectionReport")

    strSQL = "SELECT CM_qryCollectionEdit2.CATEGORY, CM_qryCollectionEdit2.Part_No, CM_qryCollectionEdit2.CPQ_Material, CM_qryCollectionEdit2.CPQ_LaborMach, CM_qryCollectionEdit2.CPQ_LaborAssy, CM_qryCollectionEdit2.CPQ_LaborPipe, CM_qryCollectionEdit2.CPQ_LaborTest, CM_qryCollectionEdit2.CPQ_LaborPack, CM_qryCollectionEdit2.CPQ_LaborShip, CM_qryCollectionEdit2.CPQ_Sub, " & _
                        "PM_qryOptions.Att1 As [" & AttArray(0, 1) & "], PM_qryOptions.Att2 As [" & AttArray(1, 1) & "], PM_qryOptions.Att3 As [" & AttArray(2, 1) & "], PM_qryOptions.Att4 As [" & AttArray(3, 1) & "], PM_qryOptions.Att5 As [" & AttArray(4, 1) & "], PM_qryOptions.Att6 As [" & AttArray(5, 1) & "], PM_qryOptions.Att7 As [" & AttArray(6, 1) & "], PM_qryOptions.Att8 As [" & AttArray(7, 1) & "], PM_qryOptions.Att9 As [" & AttArray(8, 1) & "], PM_qryOptions.Att10 As [" & AttArray(9, 1) & "], PM_qryOptions.Att11 As [" & AttArray(10, 1) & "], PM_qryOptions.Att12 As [" & AttArray(11, 1) & "], PM_qryOptions.Att13 As [" & AttArray(12, 1) & "], PM_qryOptions.Att14 As [" & AttArray(13, 1) & "], PM_qryOptions.Att15 As [" & AttArray(14, 1) & "], PM_qryOptions.Att16 As [" & AttArray(15, 1) & "], PM_qryOptions.Att17 As [" & AttArray(16, 1) & "], PM_qryOptions.Att18 As [" & AttArray(17, 1) & "], PM_qryOptions.Att19 As [" & AttArray(18, 1) & "], PM_qryOptions.Att20 As [" & AttArray(19, 1) & "] " & _
                "FROM CM_qryCollectionEdit2 INNER JOIN PM_qryOptions ON CM_qryCollectionEdit2.Part_No = PM_qryOptions.Part_No " & _
                "WHERE ((CM_qryCollectionEdit2.CAT_ID)=" & Me.cboFamily & " AND ((CM_qryCollectionEdit2.CPQ_Publish)=True));"
    qryCPQ.SQL = strSQL
    qryCPQ.Close
    'Set qryCPQ = Nothing
End With

DoCmd.OpenQuery "CM_qryCollectionReport", , acReadOnly

Set dbs = CurrentDb

For x = 1 To 20
    Set fld = dbs.QueryDefs!CM_qryCollectionReport.Fields(AttArray(x - 1, 1))
    fld.Properties("ColumnHidden") = False

    ' Error may have occurred when value was set.
    ' Display error message or create property when property didn't exist
    If Err.Number <> 0 Then
        If Err.Number <> conErrPropertyNotFound Then
            On Error GoTo 0
            MsgBox "Couldn't set property 'ColumnHidden' " & _
                   "on field '" & fld.Name & "'", vbCritical
        Else
            On Error GoTo 0
            Set prp = fld.CreateProperty("ColumnHidden", dbLong, False)
            fld.Properties.Append prp
        End If
    End If


    strColumn = "SELECT * FROM PM_Attributes WHERE CAT_ID=" & Forms!CM_frmCollectionReportPre!cboFamily & " AND [ATTRIBUTE]='" & AttArray(x - 1, 1) & "'"
    Set rsCOlumn = CurrentDb.OpenRecordset(strColumn, dbOpenSnapshot)

    If Not rsCOlumn.EOF Then
        If rsCOlumn![CPQ_Publish] = False Then
            fld.Properties("ColumnHidden") = True
        End If
    End If

    rsCOlumn.Close
    Set rsCOlumn = Nothing
    Set fld = Nothing
    Set prp = Nothing
Next x

Set dbs = Nothing

DoCmd.Close acForm, "CM_frmCollectionReportPre", acSaveNo
Dim rsLabel为DAO.Recordset,rsCOlumn为DAO.Recordset
Dim qryCPQ作为DAO.QueryDef
Dim strLabel作为字符串,strSQL作为字符串,strColumn作为字符串
模糊fld为刀场
Dim数据库作为DAO.Database
Dim prp作为DAO.Property
Dim AttArray作为变体
作为整数的Dim x
Const conErrPropertyNotFound=3270
'关闭错误捕获
出错时继续下一步
雷迪姆·阿塔雷(19,1)
对于x=1到20
附件(x-1,1)=“附件”和x
下一个x
strLabel=“从PM_qryLabels2中选择*,其中CAT_ID=“&Forms!”!CM\U FRM收集报告预处理!CBOFAALY
Set rsLabel=CurrentDb.OpenRecordset(strLabel,dbOpenSnapshot)
rsLabel.MoveFirst
对于x=1到20
如果不是IsNull(rsLabel.Fields(“Att”&x)),则
附件(x-1,1)=rsLabel.Fields(“附件”&x)
其他的
附件(x-1,1)=“附件”和x
如果结束
下一个x
'表单打开后,需要隐藏基于CPQ_发布的列
使用CurrentDb
设置qryCPQ=.querydfs(“CM_qryCollectionReport”)
strSQL=“选择CM_qryCollectionEdit2.CATEGORY,CM_qryCollectionEdit2.Part_No,CM_qryCollectionEdit2.CPQ_材质,CM_qryCollectionEdit2.CPQ_Laborary Mach,CM_qryCollectionEdit2.CPQ_Laborary Assembly,CM_qryCollectionEdit2.CPQ_Laborary管道,CM_qryCollectionEdit2.CPQ_Laborary Test,CM_qryCollectionEdit2.CPQØLaborary,CM_qryCollectionEdit2.CPQ_Sub,”&_
“PM_qryOptions.Att1 As[”&附件(0,1)&“],PM_qryOptions.Att2 As[”&附件(1,1)&“],PM_qryOptions.Att3 As[”&附件(2,1)&“],PM_qryOptions.Att4 As[”&附件(3,1)&“],PM_qryOptions.Att5 As[”&附件(4,1)&“],PM_qryOptions.attions.Att5 As[”&附件(4,1)&“,”PM_qryOptions.6 As[”&附件(5,1)&],PM_qryOptions.Att8 As[“&AttArray(7,1)&”]、PM_qryOptions.Att9 As[“&AttArray(8,1)&”]、PM_qryOptions.Att10 As[“&AttArray(9,1)&”、PM_qryOptions.Att11 As[“&AttArray(10,1)&”]、PM_qryOptions.Att12 As[“&AttArray(11,1)&”、PM_qryOptions.13 As[“&AttArray(12,1,1)&],PM_qryOptions.Att15 As[“&AttArray(14,1)&”]、PM_qryOptions.Att16 As[“&AttArray(15,1)&”]、PM_qryOptions.Att17 As[“&AttArray(16,1)&”]、PM_qryOptions.Att18 As[“&AttArray(17,1)&”]、PM_qryOptions.Att19 As[“&AttArray(18,1)&”、PM_qryOptions.20 As[“&AttArray(19,1)&”]_
“从CM_qryCollectionEdit2内部连接CM_qryCollectionEdit2.Part_No=PM_qryOptions.Part_No”&_
其中((CM_qryCollectionEdit2.CAT_ID)=“&Me.cbofamaly&”和((CM_qryCollectionEdit2.CPQ_Publish)=True);"
qryCPQ.SQL=strSQL
qryCPQ.关闭
'设置qryCPQ=无
以
DoCmd.OpenQuery“CM_qryCollectionReport”,仅限acReadOnly
设置dbs=CurrentDb
对于x=1到20
Set fld=dbs.querydfs!cmqrycollectionreport.Fields(附件(x-1,1))
fld.Properties(“ColumnHidden”)=假
'设置值时可能发生错误。
'当属性不存在时显示错误消息或创建属性
如果错误号为0,则
如果找不到错误号conErrPropertyNotFound,则
错误转到0
MsgBox“无法设置属性'ColumnHidden'”&_
“在字段'&fld.Name&''上,vbCritical”
其他的
错误转到0
设置prp=fld.CreateProperty(“ColumnHidden”,dbLong,False)
fld.Properties.Append prp
如果结束
如果结束
strColumn=“从PM_属性中选择*,其中CAT_ID=“&Forms!CM_frmCollectionReportPre!cbofamaly&”和[ATTRIBUTE]=”&AttArray(x-1,1)和“”
Set rsCOlumn=CurrentDb.OpenRecordset(strColumn,dbOpenSnapshot)
如果不是rsCOlumn.EOF,则
如果rsCOlumn![CPQ_Publish]=False,则
fld.Properties(“ColumnHidden”)=真
如果结束
如果结束
rsCOlumn,关闭
设置rsCOlumn=Nothing
设置fld=无
设置prp=无
下一个x
设置dbs=Nothing
文件关闭acForm,“CM_frmCollectionReportPre”,acSaveNo
错误屏幕截图:


如果您仔细查看您提到的文章中的示例代码,其中包括错误捕获和创建属性(如果不存在)。这是因为基于不可预测的情况,属性可能存在,也可能不存在

改编自

Const conErrPropertyNotFound=3270
'关闭错误捕获。
出错时继续下一步
'在此将字段设置为false
fld.Properties(“ColumnHidden”)=假
'设置值时可能发生错误。
'当属性不存在时显示错误消息或创建属性
如果错误号为0,则
如果找不到错误号conErrPropertyNotFound,则
错误转到0
MsgBox“无法设置属性'ColumnHidden'”&_
“在字段'&fld.Name&''上,vbCritical”
其他的
错误转到0
设置prp=fld.CreateProperty(“ColumnHidden”,dbLong,False)
fld.Properties.Append prp
如果结束
如果结束
由于您已经将字段设置为
False
,因此在将字段设置回
True
时,如果字段不存在,则不需要设置错误陷阱

您还可以选择通过i检查属性是否存在
 Const conErrPropertyNotFound = 3270

' Turn off error trapping.
On Error Resume Next

'Set the field to false here
fld.Properties("ColumnHidden") = False

' Error may have occurred when value was set.
' Display error message or create property when property didn't exist
If Err.Number <> 0 Then
    If Err.Number <> conErrPropertyNotFound Then
        On Error GoTo 0
        MsgBox "Couldn't set property 'ColumnHidden' " & _
               "on field '" & fld.Name & "'", vbCritical
    Else
        On Error GoTo 0
        Set prp = fld.CreateProperty("ColumnHidden", dbLong, False)
        fld.Properties.Append prp
    End If
End If