Virtual checkboxes
in [Help]
|
From: Salad on 5 Jun 2010 16:40 At times I've wished I could have a virtual checkbox to select items for further action. Maybe you have a bunch of records in a form but only want to see a report of those you've flagged for display in a report. (Similar to a multiselect listbox but using a form instead). I wrote a small app to do that (code below). It's not a class but could be converted to one. It assumes you have a table/query that has a primary key. It also assumes the primary key is a longInt (ex: autonumber). It assumes that the default checkbox value is false but if you want to, you can set the initial value of the checkbox to True. Let's say you have a table called Customer with 2 fields; CustomerID, CustomerName. The app will create a table link and query called qryCheckTableN (where N is a number) and will contain the customerid, customername, and a checkbox. This query could now be your recordsource. It creates a database in the same folder you run the app from called CheckTable if it doesn't exist. It then finds the next CheckTable to make. And it creates a table in that database. It then creates a link and a query in the FE you run it from. The resulting query, qryCheckTable1, might look like Select CustomerID, CustomerName, CheckBox From ... It's a function. So you might do something like this Dim strQuery As String strQuery = CTInitialize("CustomerID","Customer") 'checkbox false or strQuery = CTInitialize("CustomerID","Customer",True) so all values of checkbox are true. If you had a query like "Select CustomerID, CustomerName From Customer" and it was save as Query1, you could also do strQuery = CTInitialize("CustomerID","Query1") strQuery would then have a value of "qryCheckTable1" or something similar to point to the query that was created after running the above code When ready to unload the form/rpt/etc, enter something like CTDelete strQuery to delete the link, query, and table in the external database This would be best for small data sets as one doesn't want to delay users from getting to the data. Here's the code. Copy this into a new module to run. '**************** Start Of Code ********************** Option Compare Database Option Explicit Const TableName = "CheckTable" Public Function CTInitialize(strPrimaryKey As String, _ strPrimaryTable As String, _ Optional chkSetAsTrue As Variant) As String 'strPrimaryKey is the field name from the main table to link to 'strPrimaryTable is the table/query that holds the primary key 'chkSetAsTrue will set all checkboxes to value supplied 'Useage: strQuery = CTInitialize("Table1", "Table1Key") ' strQuery = CTInitialize("Table1", "Table1Key", True) Dim dbs As Database Dim strNewTable As String Dim strDBS As String strDBS = CurrentDb.Name strDBS = Left(strDBS, InStrRev(strDBS, "\")) & TableName & ".mdb" 'make the database if needed If Dir(strDBS) = "" Then MakeNewDatabase strDBS Set dbs = OpenDatabase(strDBS) 'delete tables from the temp database if they are older than 6 days DelCheckTables dbs 'get name to hold the check table strNewTable = NewCheckName(dbs) 'now make the new CheckTable? MakeNewTable dbs, strPrimaryKey, strNewTable 'now link the new table DoCmd.TransferDatabase acLink, "Microsoft Access", strDBS, _ acTable, strNewTable, strNewTable dbs.Close Set dbs = Nothing 'now appendrecs AppendRecs strPrimaryKey, strNewTable, strPrimaryTable, _ IIf(IsMissing(chkSetAsTrue), False, True) 'now join the two tables together by making a query CreateCheckTableQuery strPrimaryKey, strNewTable, strPrimaryTable 'return the new query that contains the main table with checkboxes CTInitialize = "qry" & strNewTable End Function Private Sub MakeNewDatabase(strNewDatabase As String) 'this creates a new database called CHECKTABLE in the 'current FE folder Dim strDBS As String Dim dbsNew As Database Dim wrkDefault As Workspace 'Get default Workspace. Set wrkDefault = DBEngine.Workspaces(0) ' Create a new database Set dbsNew = wrkDefault.CreateDatabase(strNewDatabase, _ dbLangGeneral) dbsNew.Close Set dbsNew = Nothing End Sub Private Sub MakeNewTable(dbs As Database, strKey As String, strNewTable) 'this makes a new checktable Dim tdf As TableDef Dim fld As Field Dim prp As Property 'create the new table. Set tdf = dbs.CreateTableDef(strNewTable) With tdf 'the new table will always contain 2 fields; 'the key's field name and the checkbox field .Fields.Append .CreateField(strKey, dbLong) .Fields.Append .CreateField("CheckYesNo", dbBoolean) 'add the new table to the database dbs.TableDefs.Append tdf Set fld = tdf.Fields("CheckYesNo") Set prp = fld.CreateProperty("DisplayControl", _ dbInteger, acCheckBox) fld.Properties.Append prp End With End Sub Private Sub DelCheckTables(dbs As Database) Dim dbsCurrent As Database Dim tdf As TableDef Dim strTable As String Set dbsCurrent = CurrentDb strTable = TableName 'delete the links of unnecessary files in this database For Each tdf In dbsCurrent.TableDefs If Left(tdf.Name, 10) = TableName Then If CDate(Format(tdf.DateCreated, "mm/dd/yyyy")) <= Date - 7 Then DoCmd.DeleteObject acTable, tdf.Name End If End If Next 'delete the tables of unnecessary files For Each tdf In dbs.TableDefs If Left(tdf.Name, 10) = TableName Then If CDate(Format(tdf.DateCreated, _ "mm/dd/yyyy")) <= Date - 7 Then DoCmd.DeleteObject acTable, tdf.Name End If End If Next End Sub Private Function NewCheckName(dbs As Database) As String Dim intCheck As Integer Dim tdf As TableDef Do While True On Error GoTo 0 On Error Resume Next intCheck = intCheck + 1 Set tdf = dbs.TableDefs(TableName & intCheck) If Err.Number > 0 Then NewCheckName = TableName & intCheck Exit Do End If Loop End Function Private Sub AppendRecs(strPrimaryKey As String, strNewTable As String, _ strPrimaryTable As String, bln As Boolean) 'append the record key from primary table into CheckTableX Dim strSQL As String strSQL = "INSERT INTO " & strNewTable & _ "(" & strPrimaryKey & ", CheckYesNo) SELECT " & _ strPrimaryTable & "." & strPrimaryKey & ", " & bln & _ " From " & strPrimaryTable DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True End Sub Private Sub CreateCheckTableQuery(strPrimaryKey As String, _ strNewTable As String, strPrimaryTable As String) Dim dbs As Database Dim qdf As QueryDef Dim strSQL As String strSQL = "Select " & strPrimaryTable & ".* , " & _ strNewTable & ".CheckYesNo " & _ "From " & strPrimaryTable & " Inner Join " & _ strNewTable & " On " & _ strPrimaryTable & "." & strPrimaryKey & " = " & _ strNewTable & "." & strPrimaryKey Set dbs = CurrentDb Set qdf = dbs.CreateQueryDef("qry" & strNewTable, strSQL) dbs.Close Set dbs = Nothing End Sub Public Sub CTDelete(strQuery As String) 'remove the CheckTable link and query from currentdb 'Useage: strQuery = InitializeIt("Table1", "Table1Key") ' CTDelete (strQuery) Dim tdf As TableDef Dim strDBS As String Dim strSQL As String DoCmd.DeleteObject acQuery, strQuery DoCmd.DeleteObject acTable, Mid(strQuery, 4) strDBS = CurrentDb.Name strDBS = Left(strDBS, InStrRev(strDBS, "\")) & TableName & ".mdb" strSQL = "DROP TABLE " & strDBS & "." & Mid(strQuery, 4) DoCmd.RunSQL strSQL End Sub '**************** End Of Code **********************
From: Marshall Barton on 5 Jun 2010 22:50 That's pretty elaborate and should cover all kinds of situations. Personally, the few times I needed that kind of thing, I used Albert's Multi Select example at: http://www.members.shaw.ca/AlbertKallal/msaccess/msaccess.html -- Marsh Salad wrote: >At times I've wished I could have a virtual checkbox to select items for >further action. Maybe you have a bunch of records in a form but only >want to see a report of those you've flagged for display in a report. >(Similar to a multiselect listbox but using a form instead). > >I wrote a small app to do that (code below). It's not a class but could >be converted to one. It assumes you have a table/query that has a >primary key. It also assumes the primary key is a longInt (ex: >autonumber). It assumes that the default checkbox value is false but if >you want to, you can set the initial value of the checkbox to True. > >Let's say you have a table called Customer with 2 fields; CustomerID, >CustomerName. The app will create a table link and query called >qryCheckTableN (where N is a number) and will contain the customerid, >customername, and a checkbox. This query could now be your recordsource. > >It creates a database in the same folder you run the app from called >CheckTable if it doesn't exist. It then finds the next CheckTable to >make. And it creates a table in that database. It then creates a link >and a query in the FE you run it from. The resulting query, >qryCheckTable1, might look like > Select CustomerID, CustomerName, CheckBox From ... > >It's a function. So you might do something like this > Dim strQuery As String > strQuery = CTInitialize("CustomerID","Customer") 'checkbox false > or > strQuery = CTInitialize("CustomerID","Customer",True) > so all values of checkbox are true. > > If you had a query like > "Select CustomerID, CustomerName From Customer" > and it was save as Query1, you could also do > strQuery = CTInitialize("CustomerID","Query1") > > strQuery would then have a value of "qryCheckTable1" or > something similar to point to the query that was created after > running the above code > > When ready to unload the form/rpt/etc, enter something like > CTDelete strQuery > to delete the link, query, and table in the external database > >This would be best for small data sets as one doesn't want to delay >users from getting to the data. > >Here's the code. Copy this into a new module to run. >'**************** Start Of Code ********************** >Option Compare Database >Option Explicit >Const TableName = "CheckTable" >Public Function CTInitialize(strPrimaryKey As String, _ > strPrimaryTable As String, _ > Optional chkSetAsTrue As Variant) As String > > 'strPrimaryKey is the field name from the main table to link to > 'strPrimaryTable is the table/query that holds the primary key > 'chkSetAsTrue will set all checkboxes to value supplied > 'Useage: strQuery = CTInitialize("Table1", "Table1Key") > ' strQuery = CTInitialize("Table1", "Table1Key", True) > > Dim dbs As Database > Dim strNewTable As String > Dim strDBS As String > > strDBS = CurrentDb.Name > strDBS = Left(strDBS, InStrRev(strDBS, "\")) & TableName & ".mdb" > > 'make the database if needed > If Dir(strDBS) = "" Then MakeNewDatabase strDBS > > Set dbs = OpenDatabase(strDBS) > > 'delete tables from the temp database if they are older than 6 days > DelCheckTables dbs > > 'get name to hold the check table > strNewTable = NewCheckName(dbs) > > 'now make the new CheckTable? > MakeNewTable dbs, strPrimaryKey, strNewTable > > 'now link the new table > DoCmd.TransferDatabase acLink, "Microsoft Access", strDBS, _ > acTable, strNewTable, strNewTable > > dbs.Close > Set dbs = Nothing > > 'now appendrecs > AppendRecs strPrimaryKey, strNewTable, strPrimaryTable, _ > IIf(IsMissing(chkSetAsTrue), False, True) > > > 'now join the two tables together by making a query > CreateCheckTableQuery strPrimaryKey, strNewTable, strPrimaryTable > > 'return the new query that contains the main table with checkboxes > CTInitialize = "qry" & strNewTable >End Function > >Private Sub MakeNewDatabase(strNewDatabase As String) > 'this creates a new database called CHECKTABLE in the > 'current FE folder > Dim strDBS As String > Dim dbsNew As Database > Dim wrkDefault As Workspace > > 'Get default Workspace. > Set wrkDefault = DBEngine.Workspaces(0) > > ' Create a new database > Set dbsNew = wrkDefault.CreateDatabase(strNewDatabase, _ > dbLangGeneral) > dbsNew.Close > Set dbsNew = Nothing >End Sub > >Private Sub MakeNewTable(dbs As Database, strKey As String, strNewTable) > 'this makes a new checktable > Dim tdf As TableDef > Dim fld As Field > Dim prp As Property > > 'create the new table. > Set tdf = dbs.CreateTableDef(strNewTable) > > With tdf > 'the new table will always contain 2 fields; > 'the key's field name and the checkbox field > .Fields.Append .CreateField(strKey, dbLong) > .Fields.Append .CreateField("CheckYesNo", dbBoolean) > > > 'add the new table to the database > dbs.TableDefs.Append tdf > > Set fld = tdf.Fields("CheckYesNo") > > Set prp = fld.CreateProperty("DisplayControl", _ > dbInteger, acCheckBox) > fld.Properties.Append prp > > End With >End Sub > >Private Sub DelCheckTables(dbs As Database) > Dim dbsCurrent As Database > Dim tdf As TableDef > Dim strTable As String > > Set dbsCurrent = CurrentDb > > strTable = TableName > 'delete the links of unnecessary files in this database > For Each tdf In dbsCurrent.TableDefs > If Left(tdf.Name, 10) = TableName Then > If CDate(Format(tdf.DateCreated, "mm/dd/yyyy")) <= Date - 7 Then > DoCmd.DeleteObject acTable, tdf.Name > End If > End If > Next > > 'delete the tables of unnecessary files > For Each tdf In dbs.TableDefs > If Left(tdf.Name, 10) = TableName Then > If CDate(Format(tdf.DateCreated, _ > "mm/dd/yyyy")) <= Date - 7 Then > DoCmd.DeleteObject acTable, tdf.Name > End If > End If > Next >End Sub > >Private Function NewCheckName(dbs As Database) As String > Dim intCheck As Integer > Dim tdf As TableDef > > Do While True > On Error GoTo 0 > On Error Resume Next > intCheck = intCheck + 1 > Set tdf = dbs.TableDefs(TableName & intCheck) > If Err.Number > 0 Then > NewCheckName = TableName & intCheck > Exit Do > End If > Loop >End Function > >Private Sub AppendRecs(strPrimaryKey As String, strNewTable As String, _ > strPrimaryTable As String, bln As Boolean) > 'append the record key from primary table into CheckTableX > Dim strSQL As String > strSQL = "INSERT INTO " & strNewTable & _ > "(" & strPrimaryKey & ", CheckYesNo) SELECT " & _ > strPrimaryTable & "." & strPrimaryKey & ", " & bln & _ > " From " & strPrimaryTable > DoCmd.SetWarnings False > DoCmd.RunSQL strSQL > DoCmd.SetWarnings True >End Sub > >Private Sub CreateCheckTableQuery(strPrimaryKey As String, _ > strNewTable As String, strPrimaryTable As String) > Dim dbs As Database > Dim qdf As QueryDef > Dim strSQL As String > strSQL = "Select " & strPrimaryTable & ".* , " & _ > strNewTable & ".CheckYesNo " & _ > "From " & strPrimaryTable & " Inner Join " & _ > strNewTable & " On " & _ > strPrimaryTable & "." & strPrimaryKey & " = " & _ > strNewTable & "." & strPrimaryKey > > Set dbs = CurrentDb > Set qdf = dbs.CreateQueryDef("qry" & strNewTable, strSQL) > > dbs.Close > Set dbs = Nothing >End Sub > >Public Sub CTDelete(strQuery As String) > 'remove the CheckTable link and query from currentdb > 'Useage: strQuery = InitializeIt("Table1", "Table1Key") > ' CTDelete (strQuery) > Dim tdf As TableDef > Dim strDBS As String > Dim strSQL As String > > DoCmd.DeleteObject acQuery, strQuery > DoCmd.DeleteObject acTable, Mid(strQuery, 4) > > strDBS = CurrentDb.Name > strDBS = Left(strDBS, InStrRev(strDBS, "\")) & TableName & ".mdb" > > strSQL = "DROP TABLE " & strDBS & "." & Mid(strQuery, 4) > DoCmd.RunSQL strSQL > >End Sub >'**************** End Of Code **********************
From: Albert D. Kallal on 6 Jun 2010 01:11 "Marshall Barton" <marshbarton(a)wowway.com> wrote in message news:i13m061r3e7ldnck2lhkanh5cauu4855i0(a)4ax.com... > That's pretty elaborate and should cover all kinds of > situations. Personally, the few times I needed that kind of > thing, I used Albert's Multi Select example at: > http://www.members.shaw.ca/AlbertKallal/msaccess/msaccess.html > -- > Marsh > Thanks Marsh. My example works with un-bound boxes and the whole thing is run by less then 10 lines of VBA code. -- Albert D. Kallal (Access MVP) Edmonton, Alberta Canada pleaseNOOSpamKallal(a)msn.com
From: Lars Brownies on 6 Jun 2010 02:39 That's very nice. I noticed that there's a slight delay in making the checkbox selections visible. Also, because of the requery, all selections blink for a moment when you do a checkbox selection. I tried docmd.echo but that doesn't help. Is there another way to solve that problem? Lars "Albert D. Kallal" <PleaseNOOOsPAMmkallal(a)msn.com> schreef in bericht news:06GOn.92885$_84.36110(a)newsfe18.iad... > "Marshall Barton" <marshbarton(a)wowway.com> wrote in message > news:i13m061r3e7ldnck2lhkanh5cauu4855i0(a)4ax.com... >> That's pretty elaborate and should cover all kinds of >> situations. Personally, the few times I needed that kind of >> thing, I used Albert's Multi Select example at: >> http://www.members.shaw.ca/AlbertKallal/msaccess/msaccess.html >> -- >> Marsh >> > > Thanks Marsh. > > My example works with un-bound boxes and the whole thing is run by less > then 10 lines of VBA code. > > > -- > Albert D. Kallal (Access MVP) > Edmonton, Alberta Canada > pleaseNOOSpamKallal(a)msn.com > >
From: Salad on 6 Jun 2010 11:14
Albert D. Kallal wrote: > "Marshall Barton" <marshbarton(a)wowway.com> wrote in message > news:i13m061r3e7ldnck2lhkanh5cauu4855i0(a)4ax.com... > >> That's pretty elaborate and should cover all kinds of >> situations. Personally, the few times I needed that kind of >> thing, I used Albert's Multi Select example at: >> http://www.members.shaw.ca/AlbertKallal/msaccess/msaccess.html >> -- >> Marsh >> > > Thanks Marsh. > > My example works with un-bound boxes and the whole thing is run by less > then 10 lines of VBA code. > > I hadn't seen anyone discusss something like a virtual checkbox b4 so I wrote my little app and posted it. I was hoping there'd be an alternative to it so I was pleased that Marshall pointed me towards yours. The reason both of us did it is because it doesn't exist in Access and there is/was a need to have something like it for some reason. I have to admit your's is much simpler than mine and I remain impressed. And it does use less code. But if code were an issue we'd all be using abacuses. I made a copy of your form. I added the line Dim strQuery As String under Option Explicit and under Form Open strQuery = CTInitialize("ContactID", "Contacts") Me.RecordSource = strQuery and under Form__Close Me.RecordSource = "" CTDelete (strQuery) Just like I don't worry about how much code there is in the background to run Access, I'm not worried about the amount of code to run the above. I then did a ? CTInitialize("ContactID","Contacts") to get a record source and added my checkbox and removed yours then cleared out the recordsource and ran. As Lars noted, in your example there is a slight delay when selecting/deselecting a checkbox and there is some blinking from the requery. If those didn't exist I would use your solution. I did not notice any difference in the loading of the form. I also have to look at both the developer and user experience, the user experience the ultimate arbiter, and will use my method. I'm glad there is a solution regardless. It would be nice if SQL provided us with a virtual checkbox as I'm sure there'd be instances where such a feature would be handy, not just within Access, but displaying data in other front ends. |