| 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: |