0

MS Access フォームで複数の画像を参照するプロジェクトのRoggers hereによるサンプルを変更しようとしています。

しかし、画像コントロールのオンクリック イベントを追加して詳細フォームを開く方法を知りたいです。

フォームの背後にあるコードは次のとおりです。

    Private Sub P_FillControls()
On Error GoTo ErrTrap

    Dim Cnt As Long

    Cnt = 1
    Do Until (Cnt > BlockSize Or rst.EOF)
        P_SetValues Cnt

        Cnt = Cnt + 1
        rst.MoveNext
    Loop

    If Cnt <= BlockSize Then
        For Cnt = Cnt To BlockSize
            P_SetNulls Cnt
        Next
    End If

ExitPoint:
    On Error GoTo 0
    Exit Sub

ErrTrap:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitPoint
End Sub

Private Sub P_SetValues(Cnt As Long)
On Error GoTo ErrTrap

    If RecCount > 0 Then
        Me("Rn_" & Format(Cnt, "00")).Caption = (rst.AbsolutePosition + 1)
    Else
        Me("Rn_" & Format(Cnt, "00")).Caption = ""
    End If

    Me("Lb_" & Format(Cnt, "00")).Caption = Nz(rst.Fields("ImageName"), "")
    Me("Im_" & Format(Cnt, "00")).Picture = Nz(rst.Fields("ImageFile"), "")
    Me("ID_" & Format(Cnt, "00")) = rst.Fields("ImageFile")

    ' Note - For no caption, dot is used in lieu of
    '            zero length string, so as to prevent the
    '            label from disappearing

ExitPoint:
    On Error GoTo 0
    Exit Sub

ErrTrap:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitPoint
End Sub

Private Sub P_SetNulls(Cnt As Long)
On Error GoTo ErrTrap

    Me("Rn_" & Format(Cnt, "00")).Caption = "."
    Me("Lb_" & Format(Cnt, "00")).Caption = "."
    Me("Im_" & Format(Cnt, "00")).Picture = "."
    Me("ID_" & Format(Cnt, "00")) = Null

    ' Note - For no caption, dot is used in lieu of
    '            zero length string, so as to prevent the
    '            label from disappearing

ExitPoint:
    On Error GoTo 0
    Exit Sub

ErrTrap:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitPoint
End Sub

Public Sub P_Initialize()
    On Error Resume Next

    RecCount = 0    ' Default
    Me.LbNoImage.Visible = False

    ' Remove any existing instance of the recordset
    If Not rst Is Nothing Then
        rst.Close
        Set rst = Nothing
    End If

    ' This recordset will finally get closed in form's
    ' close event.

    Set rst = CurrentDb.OpenRecordset("Q_ImageNormalSort")
   ' Set rst = CurrentDb.OpenRecordset("Q_Dynamic_Query")

    If rst.EOF And rst.BOF Then
        ' There are no records
        P_FillControls
        Me.LbNoImage.Visible = True
        P_SetStatusNavBtns
        Me.CmdAdd.SetFocus
        Exit Sub
    End If

    rst.MoveLast
    RecCount = rst.RecordCount
    LastID = rst.Fields("ImageFile")
    rst.MoveFirst
    FirstID = rst.Fields("ImageFile")

    ' First Load (signified by step size argument = 0)
    P_Next 0

    Me.LbRecMsg.Caption = "Of  " & RecCount

    On Error GoTo 0
End Sub

サンプルでは、​​「Im_」はフォーム上の画像を保持するコントロールです。

私はあなたの助けに感謝します。

ジョセフ

4

1 に答える 1

0

次の Sub をコードの下部のどこかに配置します。

Function OpenMyForm(strFormName As String)
    DoCmd.OpenForm strFormName
End Function

画像を設定する場所の下のコードにこれを貼り付けます。

Me("Im_" & Format(Cnt, "00")).OnClick = "=OpenMyForm('F_Details')"
于 2013-09-12T18:24:34.297 に答える