Skip to main content

Create selection box for Subs in Main

Hello guys, I´m struggeling with my current project.
I wrote serveral Subs in my script and have to activate or deactivate them by setting a comme symbol like this one " ' " informt of their reference in Main. Now I wonder, if it is possible to open an dialog box at the beginning of the macro, with check boxes an select the wanted/needed Subs, so i dont have so addapt the script every time or have alls Subs running at one time.
Thanks a lot for any help and suggestions
Maurice
 
 

CasinoHorst Thu, 09/22/2022 - 06:28

Hi Brian,
thanks for the video it was a big help!
So far I was able to adapt the dialog box an copy the functions to my needs as shown in the video.
If I run this in a blank projekt, the dialog box will pop up, the check boxes will work correctly. All fine.
Next step woul be to connect the check boxes fom the dialog box to the existing subs shown in the screenshot above.
How can I activate the exsiting subs with the selection made in the dialog box?
Thanks for your help!
Maurice
#########################################################################
Option Explicit
Dim sFilename As String
Dim bExitScript As Boolean
Sub Main
        Call menu()
        If Not bExitScript Then          
        Else
               MsgBox "Makro abgebrochen."
        End If
End Sub '-------------------------------------------------------------------------------------------------------------
 
Function menu()
        Dim dlg As dlgAuswahlSub
        Dim button As Integer
        On Error Resume Next
        sFilename = Client.CurrentDatabase.Name
        button = Dialog(dlg)
        If button = 0 Then bExitScript = True
End Function '-------------------------------------------------------------------------------------------------------------
 
Function displayIt(ControlID$, Action%, SuppValue%)
        Dim bExitMenu As Boolean
        Dim bExitScript As Boolean
        Dim chkValue As Integer
        
Select Case ControlID$
 
Case "cbAll"
                                     If DlgValue("cbAll") Then
                                              chkValue = 1
                                     Else
                                              chkValue = 0
                                    End If
                                                 DlgValue("cbHumanUser"), chkValue
                                                 DlgValue("cbTimeStampManual"), chkValue
                                                 DlgValue("cbTimeStamp200000230000"), chkValue
                           
 Case "OKButton1"
                  bExitMenu = True
                                      
Case "CancelButton1"
                  bExitMenu = True
                  bExitScript = True              
End Select
        
        If bExitMenu Then
               displayIt = 0
        Else
               displayIt = 1
        End If
 
End Function '-------------------------------------------------------------------------------------------------------------

The website encountered an unexpected error. Try again later.