VBA / Access: Как остановить "Вы ... ФОРМА, чтобы быть активным окном"

Question

Я хочу быть в состоянии сказать, если форма является активным окном.

Кажется, просто вызов этого метода приводит к ошибке.Я думаю, что я мог бы поймать эту ошибку и запустить с ней, но это обратный способ сделать это.

Screen.ActiveForm.Name

Эта форма должна быть активной.Если я нарушаю какие-либо правила stackOverflow, будьте добры и напомните мне, что я новичок в форуме.

Screen.parent, screen.activeControl и т. Д. Что делать, если редактор VBA открыт, как это часто бывает?

Function CStatus(strStatus, ByRef intType As Integer, Optional ByRef erNo, Optional erMsg, Optional strDatum)
'pXname = "CStatus"
'pXStack = Left(pXStack, 500) & ">" & pXname
'Updates and manages the status bar

Dim strPreamble As String, strOut As String, strForm As String, strComment As String, strSQL As String, strPxStack As String, strCErrStack As String
Dim intColor As Double
Dim intPreLen As Integer

'On Error GoTo err_hand


'Color Codes
'12632256 = Lt Grey
'33023 = Orange
'65280 = Green
'16744576 = Steel Grey

'Define "Constants"
intPreLen = 350 'Length of previous message cache

'** Fix missings
    If (IsMissing(strDatum) = True) Then strDatum = "[N/A]"

'** Other inits
strWindow = Screen.Parent.Name

strForm = Screen.ActiveForm.Name

'** intDebug ' Minimum Level of to report to status
'bEcho = True 'Whether to echo to status

intColor = errNoColor(intType)

'Error-level idiot explanations
strComment = "0"
    If IsMissing(erNo) Then erNo = 0
   If (IsNull(erMsg) = False) Then
   If IsMissing(erMsg) = False Then strComment = erMsg
   End If


strComment = errorTree(erNo)

strPreamble = Left(strPreamble, intPreLen) & "..."
strErrStack = Left(strErrStack, intPreLen) & " > " & pXname & ":" & intType
strCErrStack = strErrStack

reS:

If ((strForm = "finvmain") Or (strForm = "fclips")) Then Screen.ActiveForm.timeStatusUpdated = Now() 'Small field keeps time

If bEcho = True Then
    strPxStack = ""
    strCErrStack = "" 'Internal error stack
    End If

strOut = Now() & " " & intType & " (" & strType & "): " & erNo & " " & strCErrStack & " >> " & strComment & " / " & strStatus & " [" & strDatum & "] .. " & strPreamble

    If bEcho = True Then
    If (strForm = "fInvMain") Then Screen.ActiveForm.txtStatus2 = Screen.ActiveForm.txtStatus 'Added second window to show previous message
        Screen.ActiveForm.txtStatus = strOut
        End If

Screen.ActiveForm.txtStatus.ForeColor = intColor
If strForm = "fInvMain" Then strTag = Screen.ActiveForm.Controls("txttag").value

'***Event Log
    If erNo = "" Then erNo = 0
    If IsMissing(erMsg) = True Then erMsg = ""
    If IsMissing(strDatum) = True Then strDatum = ""
    If Len(strPreamble) < 2 Then strPreamble = "[None]"

'Fixxed - Syntax Error for Some Odd Reason! Apr 27th
If ((strTag = Empty) And (strForm = "fInvMain")) Then strTag = Screen.ActiveForm.txtTag 'Attempt to add tag# to entry
strStatus = cleanString(strStatus)
strDatum = cleanString(strDatum)
strComment = cleanString(strComment)

strSQL = "INSERT INTO tEvents(txtdate, myerrno, interrno, myerrmsg, interrmsg, txtform, stack, process, Datum, idLink) VALUES ('" & Now() & "','" & intType & "','" & erNo & "','" & strStatus & "','" & strComment & "','" & strForm & "','" & strErrStack & "','" & pXname & "','" & strDatum & "','" & strTag & "');"
CurrentDb.Execute strSQL, dbFailOnError

Exit Function

err_hand:
If Err.Number = 2475 Then
    bEcho = False
    Resume reS
    Else: MsgBox "555: CStatus Internal Error, Turn off error handling to view"
    End If


End Function

Мне нужна логическая истина или ложь, если форма активна.Если это не так, я не могу поместить вещи в текстовое поле в этом.

Answer 1

Чтобы определить, открыта ли конкретная форма, установите фокус на форму:

If CurrentProject.AllForms("finvmain").IsLoaded 
    strForm = "finvmain"
Elseif CurrentProject.AllForms("fclips").IsLoaded Then 
    strForm = "fclips"
End If
If strForm <> "" Then DoCmd.SelectObject acForm, strForm