I have an macro that querys a list list of "Projects" and displays them in a popup for the user to select from. I first check the Project to insure a "Security File" exists (list of project members) and then I check to see if the user is a member of the "Project". I display a MsgBox if 1) the "Security File" does not exist and 2) if the user is not a member of the "Project".
I both cases the MsgBox requires two selections of the "OK" button to clear it when it is displayed. I've tried the Application.EnableEvents = False/True that many of the threads on this subject seem to suggest, but have not been able to get anything to work without requiring two selections of the OK button.
Can someone please identify what the problem is so that I can get this code into production?
Here are the Subs that I am using for the PopUp Menu:
I both cases the MsgBox requires two selections of the "OK" button to clear it when it is displayed. I've tried the Application.EnableEvents = False/True that many of the threads on this subject seem to suggest, but have not been able to get anything to work without requiring two selections of the OK button.
Can someone please identify what the problem is so that I can get this code into production?
Here are the Subs that I am using for the PopUp Menu:
Code:
[FONT=courier new]Sub DeletePopUpMenu()
' Delete the popup menu if it already exists.
On Error Resume Next
Application.CommandBars(Mname).Delete
On Error GoTo 0
End Sub
Sub DisplayProjPopUpMenu()
' Delete the popup menu if it exist.
Call DeletePopUpMenu
Call Custom_PopUpMenu
' Show the popup menu.
On Error Resume Next
Application.CommandBars(Mname).ShowPopup
'On Error GoTo 0
End Sub
Sub Custom_PopUpMenu()
Dim i As Integer
' Add popup menu with three buttons.
i = 10
With Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, _
MenuBar:=False, Temporary:=True)
Do While Cells(i, 1).Value <> ""
With .Controls.Add(Type:=msoControlButton)
.Caption = Sheets("Summary-Data").Cells(i, 1)
.FaceId = 32
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestSelection(""" & ActiveSheet.Cells(i, 1) & """)"
End With
i = i + 1
Loop
End With
Sheets("Summary").Activate
End Sub
Sub TestSelection(projName)
Dim ProjNameArray() As String
Dim fProjSec As String
Dim fileExists As String
Dim f As Integer
Dim lineCount As Long
Dim strLine As String
Dim strUserID As String
Dim blnFound As Boolean
Application.EnableEvents = False
ProjNameArray() = Split(projName, " ")
fProjSec = "\\RPMELROY\ITK-Results" & ProjNameArray(0) & "_members.txt"
fileExists = VBA.FileSystem.Dir(fProjSec)
If fileExists = VBA.Constants.vbNullString Then
MsgBox "Security File " & ProjNameArray(0) & " does not exist." & vbCrLf & vbCrLf & "Please notify administrator.", vbCritical
ReturnCode = 99
Exit Sub
Else
f = FreeFile
strUserID = Environ("Username")
blnFound = False
Open fProjSec For Input As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f"]#f[/URL]
Do While Not EOF(f)
lineCount = lineCount + 1
Line Input [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f"]#f[/URL] , strLine
If strLine = Environ("Username") Then
blnFound = True
Exit Do
End If
Loop
End If
If blnFound Then
'Store the selected Project in Cells A1 & A3 of the Summary_Data sheet
Range("'Summary-Data'!A1") = ProjNameArray(0)
Range("'Summary-Data'!A3") = projName
Else
MsgBox "Access NOT allowed." & vbCrLf & "User is not a Project member." & vbCrLf & "Please select another Project.", vbCritical
ReturnCode = 99
End If
Application.EnableEvents = True
End Sub[/FONT]
Last edited by a moderator: