Forms

3.89 Creare a runtime una InputBox contenente una casella combinata
  Roberto, Alessandro Baraldi

A volte ci farebbe comodo che, aprendosi, una InputBox, invece di mostrarci una casella di testo dove digitare un dato, ci mostrasse una casella combinata dalla quale fosse possibile selezionare un valore tra quelli contenuti nel suo elenco.
Access non ha in maniera nativa una funzione che faccia questo, pertanto siamo costretti, quando sentiamo la necessità di una tale funzionalità, a crearci una maschera popup non associata che contenga appunto una casella combinata, maschera che poi memoriziamo nel nostro database, per poterla poi aprire in maniera modale quando vogliamo effettuare una scelta con la casella combinata in essa contenuta: i moduli di classe di tale maschera vengono congeniati in modo tale che, alla chiusura della maschera o a fronte dell'evento "Dopo aggiornamento" della casella combinata, il valore della colonna associata della casella combinata venga passato all'oggetto da cui è stata aperta la maschera popup.
Da quanto sopra scritto è evidente che si possono trovare sparse per il databse varie maschere popup create all'uopo, cosa che può comportare anche un certo impegno in programmazione.
In questa FAQ sono illustrate due soluzioni atte ad ovviare al tale fastidio, ambedue contenute nel database di esempio allegato a questa FAQ e selezionabili dalla sua maschera di apertura pigiando uno dei due bottoni di comando.

PRIMA SOLUZIONE
----------------------

Per evitare tale fastidio ho creato una funzione utente chiamata InputComboBox che, una volta registrata in un modulo standard di un database, se richiamata crea a runtime e registra nel database corrente una maschera popup contenente una casella combinata; apre tale maschera; alla sua chiusura, dopo aver selezionato un valore sulla casella combinata, ritorna all'oggetto chiamante il valore selezionato nella casella combinata; infine elimina dal database tale maschera popup.
Come avviene per la funzione intrinseca InputBox, anche la funzione InputComboBox ritorna una stringa vuota nel caso non sia stato selezionato alcun valore dalla casella combinata, oppure la maschera popup venga chiusa pigiando il tasto Annulla.
Nel caso in cui invece viene selezionato un valore dalla casella combinata, la funzione ritornerà il valore della sua prima o unica colonna.
Al momento del richiamo della funzione l'utente, oltre a indicare il prompt ed il titolo da visualizzare nella maschera popup (così come avviene per la finestra aperta da una funzione intrinseca InputBox), indicherà anche il nome della tabella che sarà impostata come origine riga della casella combinata e indicherà inoltre il numero di colonne che dovrà avere la casella combinata.
Il numero di colonne potrà essere uguale a 1 o a 2; nel primo caso l'unica colonna sarà visibile e relativa al primo campo della tabella impostata come origine riga; nell'altro caso invece la prima colonna sarà resa non visibile, ma rappresenterà comunque la colonna associata della casella combinata: nell'elenco della casella combinata risulteranno invece visibili i valori del secondo campo della tabella impostata come origine riga della casella combinata.
L'elenco della casella combinata risulterà sempre ordinato in ordine crescente.

In un modulo standard del database si deve registrare il seguente codice VBA:
Option Compare Database
Option Explicit

Public DepVal

Public Function InputComboBox(NomeTabella As String, _
NumeroColonne As Integer, Prompt As String, _
Optional ByVal Titolo As String = vbNullString)

'*********************************************************************************************
'*                      FUNZIONE CHE CREA A RUNTIME UNA INPUTCOMBOBOX 
'*********************************************************************************************
'* 
'* NomeTabella        è una stringa che contiene il nome della tabella che deve essere impostato
'*                             come origine riga della casella combinata.
'* NumeroColonne  é una variabile numerica che indica il numero delle colonne
'*                            della casella combinata.
'* Prompt                è una stringa che contiene il prompt della InputComboBox.
'* Titolo                   è una striga che contiene il titolo della InputComboBox
'*                            questo argomento è opzionale.
'*
'*********************************************************************************************

Application.Echo False
DepVal = Null
Dim NomeChiave As String
Dim rst As DAO.Recordset
Set rst = CurrentDb().OpenRecordset(NomeTabella)
If NumeroColonne <= 1 Then
    NumeroColonne = 1 'se NumeroColonne è <= 1, imposta 1 come colonne della Casella combinata
    NomeChiave = rst.Fields(0).Name 'memorizza il nome del campo di ordinamento
Else
    NumeroColonne = 2 'se NumeroColonne è > 1, imposta 2 come numero colonne della Casella combinata
    NomeChiave = rst.Fields(1).Name 'memorizza il nome del campo di ordinamento
End If
If IsMissing(Titolo) Or Titolo = vbNullString Then
    Titolo = " "
End If
    Dim frm As Form
    Dim ctlCombo As Control, ctlEtichetta As Control
    Dim ctlPuls1 As Control, ctlPuls2 As Control
    Dim intXDati As Integer, intYDati As Integer
    Dim intXEtichetta As Integer, intYEtichetta As Integer
    Dim intXPuls1 As Integer, intYPuls1 As Integer
    Dim intXPuls2 As Integer, intYPuls2 As Integer
    Dim NomeMaschera As String
    Dim strSQL As String
' Crea Stringa SQL origine riga della casella combinata
    strSQL = "SELECT DISTINCTROW * FROM " & NomeTabella & " ORDER BY " & NomeChiave & ";"
' Crea una nuova maschera non associata.
    Set frm = CreateForm
    NomeMaschera = frm.Name
' Imposta alcune proprietà della nuova maschera
    frm.PopUp = True
    frm.Modal = True
    frm.ScrollBars = 0
    frm.RecordSelectors = False
    frm.NavigationButtons = False
    frm.AutoCenter = True
    frm.Caption = Titolo
    frm.HasModule = True
    frm.CloseButton = False
    frm.ControlBox = False
' Imposta i valori di collocazione per i nuovi controlli.
    intXEtichetta = 1000
    intYEtichetta = 500
    intXDati = 1000
    intYDati = 1000
    intXPuls1 = 4000
    intYPuls1 = 500
    intXPuls2 = 4000
    intYPuls2 = 1000
' Crea casella combinata non associata nella sezione Corpo della nuova maschera.
    Set ctlCombo = CreateControl(frm.Name, acComboBox, , "", "", _
        intXDati, intYDati)
        ' Imposta alcune proprietà della casella combinata
        ctlCombo.ColumnCount = NumeroColonne
        If NumeroColonne = 1 Then
            ctlCombo.ColumnWidths = "2,5Cm"
        Else
            ctlCombo.ColumnWidths = "0cm;2,5Cm"
        End If
        ctlCombo.RowSource = strSQL
' Crea etichetta prompt
    Set ctlEtichetta = CreateControl(frm.Name, acLabel, , , _
    Prompt, intXEtichetta, intYEtichetta)
' Crea pulsante OK
    Set ctlPuls1 = CreateControl(frm.Name, acCommandButton, , , , intXPuls1, intYPuls1)
        ' Imposta le proprieta del pulsante OK
        ctlPuls1.Caption = "OK"
        ctlPuls1.Height = 400
        ctlPuls1.Width = 1152
' Crea pulsante Annulla
    Set ctlPuls2 = CreateControl(frm.Name, acCommandButton, , , , intXPuls2, intYPuls2)
        ' Imposta le proprieta del pulsante Annulla
        ctlPuls2.Caption = "Annulla"
        ctlPuls2.Height = 400
        ctlPuls2.Width = 1152
'Crea i moduli di classe della nuova maschera
    Dim mdl As Module
    Set mdl = frm.Module
    'Sub Dopo aggiornamento della casella combinata
        Dim strCodiceDopoAggiornamento As String
        strCodiceDopoAggiornamento = "Sub CasellaCombinata0_AfterUpdate()" _
            & vbCrLf & "DepVal = Me!CasellaCombinata0" _
            & vbCrLf & "End Sub"
        mdl.InsertText strCodiceDopoAggiornamento
    ' Sub Su attivato della casella combinata
        Dim strSuAttivato As String
        strSuAttivato = "Sub CasellaCombinata0_GotFocus()" _
            & vbCrLf & "Me!CasellaCombinata0.DropDown" _
            & vbCrLf & "End Sub"
        mdl.InsertText strSuAttivato
    ' Sub Su clic pulsante OK
        Dim strClicPuls1 As String
        strClicPuls1 = "Sub Comando2_Click()" _
            & vbCrLf & "DoCmd.Close" _
            & vbCrLf & "End Sub"
        mdl.InsertText strClicPuls1
    ' Sub Su clic pulsante Annulla
        Dim strClicPuls2 As String
        strClicPuls2 = "Sub Comando3_Click()" _
            & vbCrLf & "DepVal = Null" _
            & vbCrLf & "DoCmd.Close" _
            & vbCrLf & "End Sub"
        mdl.InsertText strClicPuls2
'Salva la nuova maschera nel database
    'DoEvents
    DoCmd.Close acForm, NomeMaschera, acSaveYes
Application.Echo True
'Apri in modale la nuova maschera
    DoCmd.OpenForm NomeMaschera, , , , , acDialog
'Elimina la nuova maschera dal database
    DoEvents
    DoCmd.DeleteObject acForm, NomeMaschera
DoEvents
InputComboBox = Nz(DepVal, "")
Set mdl = Nothing
Set ctlCombo = Nothing
Set ctlEtichetta = Nothing
Set ctlPuls1 = Nothing
Set ctlPuls2 = Nothing
Set frm = Nothing
Set rst = Nothing
End Function
La funzione InputComboBox può essere richiamata nel modo seguente:
Dim MiaVariabile As String
MiaVariabile = InputComboBox(NomeTabella, NumeroColonne, Prompt, Titolo)
dove NomeTabella è una stringa che contiene il nome della tabella o della query che va impostata come origine riga della casella combinata; NumeroColonne è una variabile numerica intera che contiene il numero di colonne che deve avere la casella combinata e potrà assumere solamente il valore 1 oppure il valore 2; Prompt è una stringa che verrà impostata come Caption di una etichetta che sormonta la casella combinata; infine Titolo è una stringa che verrà impostata come Caption della maschera popup.
Quest'ultimo argomento del richiamo della funzione è opzionale quindi nel richiamo della funzione può essere omesso insieme alla virgola che lo precede: l'omissione di questo argomento fa si che l'intestazione della maschera popup risulti vuota.
Il codice VBA di cui sopra è stato realizzato e testato con Access 97, ma si ritiene che debba funzionare anche con le versioni successive di Access a condizione che al database vengano aggiunti i riferimenti alla libreria Microsoft DAO 3.6 .
Può risultare particolarmente utile richiamare la funzione InputComboBox dalla sub generata a fronte dell'evento "Su apertura" di un report per filtrare il report stesso con un valore scelto da una casella combinata, senza per questo crearsi una maschera popup adatta allo scopo.
Questa prima soluzione può però essere adottata solamente in database MDB, ma non può essere realizzata in database MDE o nella loro versione runtime, ciò perché solo con un database MDB è poddibile creare o modificare la struttura di una maschera.
Per sopperire a questo limite si propone una seconda soluzione che non ha necessità di intervenire nella struttura di alcuna maschera.

SECONDA SOLUZIONE
---------------------------

Questa seconda soluzione è realizzata creando a priori e tenendo sempre registrata nel database una maschera popup generica chiamata InputComboEX.
Tale maschera contiene naturalmente una casella combinata le cui proprietà vengono impostate e personalizzate a runtime in base agli argomenti passati dall'utente al momento del richiamo della funzione InputComboEX.
Quindi per poter realizzare tale soluzione occorre importare in un database la maschera InputComboEX e poi registrare in un modulo standard del database il seguente codice VBA:
Public Function InputComboEX(OrigineRiga As String, _
                             Prompt As String, _
                             Titolo As String, _
                             Optional NumeroColonne As Integer = 2, _
                             Optional LarghezzaColonne As String = "0cm;4Cm", _
                             Optional ColonnaAssociata As Integer = 0) As Variant
                             
      On Error GoTo Err_InputComboEX
   
      Dim NomeChiave    As String
      Dim strSQL        As String
      Dim rst           As DAO.Recordset
      
      If NumeroColonne <= 1 Then
         ' se NumeroColonne è <= 1, imposta 1 come colonne della Casella combinata
         NumeroColonne = 1
         If IsMissing(LarghezzaColonne) Or InStr(LarghezzaColonne, ";") > 0 Then
            LarghezzaColonne = "4Cm"
         End If
      Else
         ' se NumeroColonne è > 1, imposta 2 come numero colonne della Casella combinata
         NumeroColonne = 2
      End If

      If IsMissing(Titolo) Or Titolo = vbNullString Then
          Titolo = "Seleziona"
      End If
      ' Verifico che non sia passata una Stringa SQL, in quel caso
      ' ipotizzo che sia già composta in modo corretto
      If InStr(OrigineRiga, "SELECT") = 0 Then
         ' Crea Stringa SQL origine riga della casella combinata
         Set rst = CurrentDb().OpenRecordset(OrigineRiga)
         If rst.EOF Then InputComboEX = Null: Exit Function
         NomeChiave = rst.Fields(NumeroColonne - 1).Name 'memorizza il nome del campo di ordinamento
         strSQL = "SELECT DISTINCTROW * FROM " & OrigineRiga & " ORDER BY " & NomeChiave & ";"
         rst.Close
         Set rst = Nothing
      Else
         strSQL = OrigineRiga
      End If
      
      DoCmd.OpenForm "ImputComboEX"
      With Forms!ImputComboEX
         .Caption = Titolo
         !cboSelect.RowSource = strSQL
         !cboSelect.Controls(0).Caption = Prompt
         !cboSelect.ColumnCount = NumeroColonne
         !cboSelect.ColumnWidths = LarghezzaColonne
         !cboSelect.BoundColumn = ColonnaAssociata
         !cboSelect.Dropdown
         .Modal = True
         ShowFormAndWait Forms!ImputComboEX
         InputComboEX = .Valore
      End With
      DoCmd.Close acForm, "ImputComboEX"
      
      Exit Function
      
Err_InputComboEX:
   MsgBox "Funzione [InputComboEX]@" & vbCrLf & _
            "[" & Err.Number & "]" & " - " & Err.Description
            
   InputComboEX = Null

End Function

Public Function ShowFormAndWait(frm As Form) As Boolean
    Dim blnCancelled As Boolean
    Dim lngLoop As Long
    Dim strNAME As String
    
    Const cInterval As Long = 1000
    
    strNAME = frm.Name
    frm.Visible = True
        
    Do
        If lngLoop Mod cInterval Then
            DoEvents
            ' E' ancora aperta?
            If Not IsOpen(strNAME) Then
                blnCancelled = True
                Exit Do
            End If
            ' OK, è aperta. ma è visibile?
            If Not frm.Visible Then
                blnCancelled = False
                Exit Do
            End If
            lngLoop = 0
        End If
        lngLoop = lngLoop + 1
    Loop
    ShowFormAndWait = Not blnCancelled
End Function

Private Function IsOpen(ByVal strFormName As String) As Integer

 ' Returns True if the specified form is open in Form view or Datasheet view.
    If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> 0 Then
        If Forms(strFormName).CurrentView <> 0 Then
            IsOpen = True
        End If
    End If
End Function
La funzione InputComboEX può essere richiamata nel modo seguente:
Dim MiaVariabile As String
MiaVariabile = InputComboEX(TabellaOrigineRiga, Prompt, Titolo, Numero Colonne, LarghezzaColonne, ColonnaAssociata)
dove TabellaOrigineRiga è il nome di una striga che contiene il nome della tabella/query che va impostata come origine riga della casella combinata oppure contiene la stringa SQL preparata dall'utente con cui impostare l'origine riga; Prompt è una stringa che verrà impostata come Caption di una etichetta che sormonta la casella combinata; Titolo è una stringa che verrà impostata come Caption della maschera popup; NumeroColonne è una variabile numerica intera opzionale che indica il numero di colonne che deve avere la casella combinata: se esiste deve contenere il valore 1 o 2, se è omessa viene assunto 1 come numero di colonne; LarghezzaColonne è una stringa opzionale che deve contenere la larghezza delle colonne: può essere omessa solo se è stato omesso l'argomento precedente, nel qual caso viene assunto come valore predefinito la stringa "4cm"; ColonnaAssociata è una variabile numerica intera opzionale e se omessa assunerà il valore 1.
Anche il codice VBA di questa seconda soluzione fa riferimento alle librerie Microsoft DAO quindi se si usa una versione di Access successiva ad Access 97 è necessario aggiungere al database i riferimenti a Microsoft DAO 3.6 Object Library.
Come si è già detto precedentemente, questa seconda soluzione può essere realizzata sia in un datbase MDB che in un database MDE o in database in versione runtime.

Download:
 
  InputComboBox.zip (125Kb) MSAccess97 database


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.