Hide data in combo box that has been previously selected (1 Viewer)

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
Hello, I have a continuous subform with a combo box (cboComponent). Every time I select an item from the combo box I want it unavailable for the next record until there is nothing to select. Can this be done? Below is the combo box SQL and the subforms record source is tbl_ComponentParts

Code:
SELECT tbl_Components.ComponentID, tbl_Components.Component, tbl_Components.IsInactive
FROM tbl_Components
WHERE (((tbl_Components.IsInactive)=False))
ORDER BY tbl_Components.Component;
 

isladogs

MVP / VIP
Local time
Today, 10:21
Joined
Jan 14, 2017
Messages
18,186
In the combo after update event, could you add code to set the IsInactive field to True?
 

CJ_London

Super Moderator
Staff member
Local time
Today, 10:21
Joined
Feb 19, 2013
Messages
16,553
perhaps something like this for your combo rowsource

Code:
SELECT tbl_Components.ComponentID, tbl_Components.Component, tbl_Components.IsInactive
FROM tbl_Components [COLOR="Red"]LEFT JOIN tbl_ComponentParts ON tbl_Components.ComponentID=tbl_ComponentParts.ComponentID[/COLOR]
WHERE (((tbl_Components.IsInactive)=False) [COLOR="red"]AND tbl_ComponentParts.ComponentID is null)[/COLOR]
ORDER BY tbl_Components.Component;

this would require your subform to be saved and the combo to be re queried after each selection
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 06:21
Joined
Feb 19, 2002
Messages
42,970
Based on your query, it looks like the PK to the lookup table is an ID rather than the visible value. If you remove used items, the combo on existing rows will go blank on a continuous form.

Why do you want to remove the already used items? If you want to prevent them from being used, do that with code in the BeforeUpdate event of the combo.
 

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
The reason I want to limit choices in the combo box is because they can only be used once per product. If you look at my example, open the (frm_UpdateProductComponentsParts) and move the records to select a new product then select a component and it cascades its data for the Parts data. You cant have the same component for the product chosen.
 

Attachments

  • F3.zip
    98.3 KB · Views: 129

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 05:21
Joined
Feb 28, 2001
Messages
26,996
OK, here is one of the old programmer's rules in action. "Access won't tell you anything you didn't tell it first." If you intend to "consume" a usage from the combo box, you need to include as part of the database the fact that a resource (one of the elements of the combo box) has been consumed. This sounds so trivial - but it is a point that we have seen too many people overlook.

Whether you have a flag for this or whether you have a temporary table that lists "consumed" entries really doesn't matter.

If you use a flag then your combo box .RowSource has to include as part of its WHERE clause "... AND ( UsedFlag = FALSE ) ..." - but then part two is to force a requery of the combo box after marking any flag TRUE.

If you have a table of used ID values, you would have a .RowSource to include as part of its WHERE clause "... AND ( IDValue NOT IN ( SELECT UsedID FROM UsedTable ) ) ..." - but then part two is to force a requery of the combo box after inserting any ID in the UsedTable.

In other words, it doesn't really matter HOW you do it, but you cannot expect Access to to show what isn't used yet unless it has a way to know what IS used.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 06:21
Joined
May 21, 2018
Messages
8,463
Take a look. This took some trickery and an update of your tables but does what was asked.
 

Attachments

  • F3_PLP_V2.accdb
    672 KB · Views: 341
Last edited:

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
Take a look. This took some trickery and an update of your tables but does what was asked.


MajP thats exactly what I needed! Thank you very much!
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 06:21
Joined
May 21, 2018
Messages
8,463
As for your tables. You need a Products table, a component table with a component ID, and a parts table with a parts ID and a foreignKey to the component table. Because all parts are related to a component your linking table really does not need the component ID foreign key. Tbl_ProductComponentParts really only needs a product ID and a Part ID because you can get the component ID from the relation to the parts table. However, in order to do the cascading you need a "fake" component id in the tblProductComponentParts. So just be aware having that value is a non-normal design because it is repeating data, but there was no other solution to get that interface. Fyi, if you are not aware of how that works there is actually a textbox on top of each combobox. This is one trick for cascading combos on a continous form.
 

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
As for your tables. You need a Products table, a component table with a component ID, and a parts table with a parts ID and a foreignKey to the component table. Because all parts are related to a component your linking table really does not need the component ID foreign key. Tbl_ProductComponentParts really only needs a product ID and a Part ID because you can get the component ID from the relation to the parts table. However, in order to do the cascading you need a "fake" component id in the tblProductComponentParts. So just be aware having that value is a non-normal design because it is repeating data, but there was no other solution to get that interface. Fyi, if you are not aware of how that works there is actually a textbox on top of each combobox. This is one trick for cascading combos on a continous form.


MajP, its been bothering me about how much you had to go through to shorten the list for components so I looked at your code for days and came up with an less code way with basically just a SQL row source for cboComponent that you were using as VBA code in the form and some refreshing the subfom by using:

Forms!frm_UpdateProductComponentsParts!sfrm_UpdateProductComponentsParts.Form!cboComponent.Requery

Because me.requery wouldnt work. Anyways, I posed the example if anyone want to look.

I do however want to do one more thing, I want to stop the allow additions once there isn't any choices left in the combo box... Ideas?
 

Attachments

  • F3 V3.zip
    92.8 KB · Views: 168

MajP

You've got your good things, and you've got mine.
Local time
Today, 06:21
Joined
May 21, 2018
Messages
8,463
Check the recordcount of the combo. If 0 set additions to false
 

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
Check the recordcount of the combo. If 0 set additions to false

how would I get the recordcount of a combobox? I tried below with no luck

Code:
Private Sub cboComponent_Dirty(Cancel As Integer)
If cboComponent.RecordsetClone.RecordCount > 1 Then
  Cancel = True
Else
  Me.AllowAdditions = False
End If
End Sub
 

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
MajP, the below works but only if I'm entering all the data and using every option in cboComponent. If I close the form and reopen it shows the extra blank record.

Code:
Private Sub cboComponent_Dirty(Cancel As Integer)
If cboComponent.ListCount > 1 Then
  Cancel = True
Else
  Me.AllowAdditions = False
End If
End Sub
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 06:21
Joined
May 21, 2018
Messages
8,463
The easiest would be to make a query and save it, which is the same as the rowsource of the combobox. Then on the current event do a dcount on that query. If not the timing to get the comb listcount would be difficult.
Code:
SELECT tbl_Components.ComponentID, tbl_Components.Component
FROM tbl_Components
GROUP BY tbl_Components.ComponentID, tbl_Components.Component, tbl_Components.IsInactive
HAVING (((tbl_Components.ComponentID) Not In (SELECT ComponentID FROM tbl_ComponentParts WHERE ProductID= [Forms]![frm_UpdateProductComponentsParts]![cboProduct])) AND ((tbl_Components.IsInactive)=False))
ORDER BY tbl_Components.Component;
 

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
Majp, the DCount worked great...

Code:
If DCount("*", "qry_AllowAdditionsUpdateProductComponentsParts") = 0 Then
        Me.AllowAdditions = False
    Else
        Me.AllowAdditions = True
    End If


I have a second question and not sure if its doable. I can start another thread if so... The DB I'm currently trying to build is a image DB for performing jobs, kinda a step by step thing. Anyways, the images I use are from a camera and I have to resize each image every time I use one. I open a dialog and search for the image and if its too big it opens paint... I want to if its to big to automatically convert its width and height to 400X400 but keep its size under 100kb. Is that doable? Bellow is the button that I use to get the image and the attachment is the module used.

Code:
Private Sub cmdImg_Add_Click()
    On Error GoTo err_cmdImg_Add_Click
    
    Dim strDialogTitle As String
    Dim PathStrg As String
    Dim relativePath As String
    Dim dbPath As String
    Dim msg As String
    
    Dim SResult As String 'ADDED for image size restriction
    Dim LResult As Long 'ADDED for image size restriction
    Dim retVal As Variant 'ADDED for image size restriction
    
    If Not IsNull(txtSetUpStepID) Then
        
'strDialogTitle = "Select an image
        PathStrg = GetOpenFile_CLT(".\", strDialogTitle)
        
'If no file was selected then the PathStrg variable will be empty.
'If there was a file selected then.....
        If PathStrg <> "" Then
'**********************************************************START IMAGE SIZE RESTRICTION*************
'http://www.techonthenet.com/access/functions/file/filelen.php
            LResult = FileLen(PathStrg)
            SResult = Format(LResult / 100000, "#0.00") & " kb" '100000 Byte = 100 Kilobyte (kb)
            
'MsgBox LResult
'MsgBox SResult
            
'If the image is larger than 100kb then or 100000 bytes
            If LResult > "100000" Then
                MsgBox "Your Image you selected is " & SResult & " which exceeds the size limit of 100kb max." & vbCrLf & _
                "When you close this prompt your image will open in Microsoft Paint so you can resize it.", vbCritical, "Image To Large"
                
'Open Microsoft Paint with oversized image
                retVal = Shell("c:\windows\system32\mspaint.exe " & Chr$(34) & PathStrg & Chr$(34), vbMaximizedFocus)
                
'Exit out of sub
                Exit Sub
                
'Else If the image is less than 100kb then or 100000 bytes then allow the image and continue
            ElseIf LResult < "100000" Then
                
'**********************************************************END IMAGE SIZE RESTRICTION***************
                
'setup new file name and appropriate DB subfolder
                relativePath = "\SetUp_Images\" & Me.txtSetUpStepID & ".jpg"
'Finds BE path in module-modGetPath
                dbPath = GetCurrentPath()
                
'copy selected file with new name and subfolder
                FileCopy LCase(PathStrg), dbPath & relativePath
                
'update the table field with the new file name and relative location
                Me!ImagePath.Value = relativePath
'**********************************************************REQUERY AND STAY ON RECORD START****************
'display the image from the subfolder of the DB
'Me.Requery
                Dim RecUF As Long
                
                RecUF = Me!SetUpStepID
                Me.Requery
                Me.Recordset.FindFirst "[SetUpStepID] = " & RecUF
'**********************************************************REQUERY AND STAY ON RECORD END******************
                
            End If
        End If 'ADDED for image size restriction
    Else
'If no ID number in (txtSetUpStepID) then display message box
        MsgBox "You must enter a SetUp step before adding an image.", vbExclamation, "Enter A SetUp Step"
        
exit_cmdImg_Add_Click:
        Exit Sub
        
err_cmdImg_Add_Click:
        Select Case Err.Number
        Case 70
            msg = "You are already using this image already for another step"
            MsgBox msg, vbOKOnly + vbInformation, "Image already in use!", Err.HelpFile, Err.HelpContext
            
        Case 76
            msg = "The image folder is not with this database or its been renamed!"
            MsgBox msg, vbOKOnly + vbInformation, "Image folder not found!", Err.HelpFile, Err.HelpContext
            
        Case Else
            msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description
            MsgBox msg, vbOKOnly, "Add/Change Image Button Error", Err.HelpFile, Err.HelpContext
        End Select
        
        Resume exit_cmdImg_Add_Click
        
    End If
End Sub
 

Attachments

  • basOpenFile.txt
    7.7 KB · Views: 104

moke123

AWF VIP
Local time
Today, 06:21
Joined
Jan 11, 2013
Messages
3,849
@CJ_London:
Thats a great little piece of code. I just google translated it to english and added it my stuff to save.
 

oxicottin

Learning by pecking away....
Local time
Today, 06:21
Joined
Jun 26, 2007
Messages
851
Thanks for the link and thanks esancha for the code. I will look at getting it working with my DB today...

Translated To English:

Code:
'************************************************* ***************************
***
'You will need to set a reference to Microsoft Windows Image Acquisition Library v2.0
'*
'* Resize
'* rescale the image passed as a parameter
'* Must include a reference to Microsoft Windows Image Acquisition Library vX.X
'* Arguments: strArchivo => path of the file to resize
'lngHigh => high in pixels to apply
'lng Width => width in pixels to apply
'* use: Resize "C: \ Temp \ test.PNG"
'* ESH 08/16/09
'* If you use this code, respect authorship and credits
'************************************************* ***************************
***

Public Sub Resize (str File As String, lng High As Long, lng Width As Long)
Dim Image As WIA.ImageFile, _
IP As WIA.ImageProcess, _
str Scaled As String

On Error GoTo Resize_TreatmentErrors

Set Image = CreateObject ("WIA.ImageFile")
Set IP = CreateObject ("WIA.ImageProcess")

Image.LoadFile (strArchivo)
IP.Filters.Add (IP.FilterInfos ("Scale"). FilterID)
IP.Filters (1) .Properties ("MaximumWidth"). Value = lng Width
IP.Filters (1) .Properties ("MaximumHeight"). Value = lngAlto
Set Image = IP.Apply (Image)

strEscalado = Replace $ (strFile, ".", ".redim.")
'if the file already exists I delete it
If Not Dir $ (strEscalado) = vbNullString Then Kill strEscalado
Image.SaveFile (strEscalado)


Resize_Exit:
If Not Image Is Nothing Then Set Image = Nothing
If Not IP Is Nothing Then Set IP = Nothing
On Error GoTo 0
Exit Sub

Resize_TreatmentErrors:
MsgBox "Error" & Err & "in proc .: Resize Module: mdl ScanWIA (" & Err.Description & ")", vbCritical + vbOKOnly, "ATTENTION"
Resume Resize_Exit

End Sub 'Resize
 

moke123

AWF VIP
Local time
Today, 06:21
Joined
Jan 11, 2013
Messages
3,849
Thanks for the link and thanks esancha for the code. I will look at getting it working with my DB today...

Translated To English:

Code:
'************************************************* ***************************
***
'You will need to set a reference to Microsoft Windows Image Acquisition Library v2.0
'*
'* Resize
'* rescale the image passed as a parameter
'* Must include a reference to Microsoft Windows Image Acquisition Library vX.X
'* Arguments: strArchivo => path of the file to resize
'lngHigh => high in pixels to apply
'lng Width => width in pixels to apply
'* use: Resize "C: \ Temp \ test.PNG"
'* ESH 08/16/09
'* If you use this code, respect authorship and credits
'************************************************* ***************************
***

Public Sub Resize (str File As String, lng High As Long, lng Width As Long)
Dim Image As WIA.ImageFile, _
IP As WIA.ImageProcess, _
str Scaled As String

On Error GoTo Resize_TreatmentErrors

Set Image = CreateObject ("WIA.ImageFile")
Set IP = CreateObject ("WIA.ImageProcess")

Image.LoadFile (strArchivo)
IP.Filters.Add (IP.FilterInfos ("Scale"). FilterID)
IP.Filters (1) .Properties ("MaximumWidth"). Value = lng Width
IP.Filters (1) .Properties ("MaximumHeight"). Value = lngAlto
Set Image = IP.Apply (Image)

strEscalado = Replace $ (strFile, ".", ".redim.")
'if the file already exists I delete it
If Not Dir $ (strEscalado) = vbNullString Then Kill strEscalado
Image.SaveFile (strEscalado)


Resize_Exit:
If Not Image Is Nothing Then Set Image = Nothing
If Not IP Is Nothing Then Set IP = Nothing
On Error GoTo 0
Exit Sub

Resize_TreatmentErrors:
MsgBox "Error" & Err & "in proc .: Resize Module: mdl ScanWIA (" & Err.Description & ")", vbCritical + vbOKOnly, "ATTENTION"
Resume Resize_Exit

End Sub 'Resize

Oxi,

you missed some errors that google translate added. Note that G.T. added spaces in a lot of words. for example - Resize (str File As String, lng High As Long, lng Width As Long)

Here's the translation I did with errors fixed.

Code:
''****************************************************************************
'***Author: Emilio Sancha MSAccess VIP   http://www.mvp-access.es/emilio/Index.htm
'' * ESH 08/16/09
''** google translated from spanish to english 9/2019
''* sRedimension
''* re-scale the last image as a parameter
''* You must include a reference to Microsoft Windows Image Acquisition Library vX.X
''* Arguments: strImage => path of the file to resize
''* lngHeight=> height in pixels to apply
'' * lngWidth => width in pixels to apply
'' * use: sRedimension "C:\Temp\test.PNG",400,400
'' * If you use this code, respect authorship and credits
''****************************************************************************

Public Sub sRedimension(strImage As String, lngHeight As Long, lngWidth As Long)

    Dim wImage As WIA.ImageFile
    Dim IP As WIA.ImageProcess
    Dim strScale As String

    On Error GoTo sRedimension_Error

    Set wImage = CreateObject("WIA.ImageFile")
    Set IP = CreateObject("WIA.ImageProcess")

    wImage.LoadFile (strImage)

    IP.Filters.Add (IP.FilterInfos("Scale").FilterID)
    IP.Filters(1).Properties("MaximumWidth").Value = lngWidth
    IP.Filters(1).Properties("MaximumHeight").Value = lngHeight

    Set wImage = IP.Apply(wImage)

    strScale = Replace$(strImage, ".", ".redim.")

    'if the file already exists I delete it
    If Not Dir$(strScale) = vbNullString Then Kill strScale

    wImage.SaveFile (strScale)

Resize_Exit:
    If Not wImage Is Nothing Then Set wImage = Nothing
    If Not IP Is Nothing Then Set IP = Nothing
    On Error GoTo 0
    Exit Sub

sRedimension_Error:
    MsgBox "Error " & Err & " in proc.: sRedimension :  (" & Err.Description & ")", vbCritical + vbOKOnly, "Attention"
    Resume Resize_Exit

End Sub

HTH
 

Users who are viewing this thread

Top Bottom