N
Nicholas Scarpinato
Hello. I have a subform problem in an Access 97 database I've been
developing. (Corporate constrictions leave me stuck with A97, I have no
choice.) I have a subform that is linked to a table. This subform has buttons
to add/remove/reorder records (the idea was to create a modular entry screen
that can add/insert/remove/move each line item rather than have to manually
copy and paste everything to add new lines, etc.). Clicking one of the
buttons runs some code which adds a new record to the underlying table,
deletes the current record, or changes the index of the record in the table
up or down as needed. The form and code is all working very well. The problem
I'm having is that when I select something in a listbox when there are more
records in the form than can fit in the subform window without scrolling, my
subform listboxes go haywire and show selected items from the record below
them (if they show anything selected at all). If I look at the underlying
table, the field which stores the values from the listbox is correct, but the
listbox displays something else.
Here is the code that I'm using to add/insert records, and the modules it
calls:
**********
Private Sub Command1_Click()
Call AddItem(Form.CurrentRecord)
End Sub
**********
Private Function AddItem(ItemIndex As Integer)
DoCmd.SetWarnings False
If DMax("[line]", "[tblDocItemsTemp]") > 15 Then
MsgBox "You have reached the maximum of 15 line items. You cannot add/insert
a new line.",vbInformation+vbOkOnly,"System Message"
DoCmd.GoToRecord acActiveDataObject, , acGoTo, ItemIndex
Goto EndProcess
End If
If DMax("[line]", "[tblDocItemsTemp]") > ItemIndex Then
DoCmd.RunSQL "UPDATE tblDocItemsTemp SET line = line + 1 WHERE line > " &
ItemIndex & ";"
End If
DoCmd.RunSQL "INSERT INTO tblDocItemsTemp (line) VALUES (" & ItemIndex + 1 &
");"
Me.RecordSource = "SELECT tblDocItemsTemp.* FROM tblDocItemsTemp ORDER BY
tblDocItemsTemp.line;"
Me.Requery
Call ProcessRecords
DoCmd.GoToRecord acActiveDataObject, , acGoTo, ItemIndex + 1
EndProcess:
DoCmd.SetWarnings True
End Function
**********
Function ProcessRecords()
Dim z As Integer
For z = 1 To 15 ' ---> I only allow for 15 lines in the entry form.
If IsNull(DLookup("[line]", "[tblDocItemsTemp]", "[line] = " &
Me.CurrentRecord + 1 & "")) = True Then
z = 15
GoTo EndProcess
End If
DoCmd.GoToRecord acActiveDataObject, , acGoTo, z
Call DepartmentRebuild
EndProcess:
Next z
Me.Requery
End Function
**********
Private Function DepartmentRebuild()
Dim rs As Recordset, i As Integer, w As Integer, x As Integer, y As Integer,
tmpstring As String, tmpstring2() As Integer, AreaName() As String,
DepartmentName() As String, varitem As Variant
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblDepartmentIDs;")
x = 1
ReDim tmpstring2(x)
ReDim Preserve DepartmentName(x)
For w = 0 To Me.department_no.ListCount - 1
Me.department_no.Selected(w) = False
Next w
Debug.Print "Line: " & Me.line & " - Department List: " & Me.applies_to
With rs
If IsNull(Me.applies_to) = True Then
GoTo NoData
End If
For y = 1 To Len(Me.applies_to)
tmpstring = Mid(Me.applies_to, y, 1)
tmpstring2(x) = tmpstring2(x) & tmpstring
If tmpstring = " " Then GoTo SkipProcess
If tmpstring = "," Then
DepartmentName(x) = DLookup("[description]",
"[tblDepartmentIDs]", "[id_num] = " & tmpstring2(x) & "")
x = x + 1
ReDim Preserve tmpstring2(x)
ReDim Preserve DepartmentName(x)
End If
If y = Len(Me.applies_to) Then
DepartmentName(x) = DLookup("[description]",
"[tblDepartmentIDs]", "[id_num] = " & tmpstring2(x) & "")
For i = 1 To x
For w = 0 To Me.department_no.ListCount - 1
If Me.department_no.ItemData(w) = DepartmentName(i) Then
Me.department_no.Selected(w) = True
w = Me.department_no.ListCount - 1
End If
Next w
Next i
End If
GoTo SkipProcess
SkipProcess:
Next y
NoData:
.MoveNext
tmpstring = ""
End With
EndProcess:
rs.Close
End Function
**********
I have a hidden field on my form called applies_to which stores a string
based on whatever the user selects in the multi-select listbox. The string is
a list of department ID numbers separated by commas which I then parse
through the DepartmentRebuild function, which selects the corresponding items
in the listbox. The applies_to field shows the correct data for each record,
but the listboxes don't match if the number of records is high enough to
force the subform to have to scroll. It's very strange. Is there anything I
can do to help ensure that the listboxes show the correct data? It's very
confusing for me, and if I kick this release to my end users, they're never
going to understand what's going on.
developing. (Corporate constrictions leave me stuck with A97, I have no
choice.) I have a subform that is linked to a table. This subform has buttons
to add/remove/reorder records (the idea was to create a modular entry screen
that can add/insert/remove/move each line item rather than have to manually
copy and paste everything to add new lines, etc.). Clicking one of the
buttons runs some code which adds a new record to the underlying table,
deletes the current record, or changes the index of the record in the table
up or down as needed. The form and code is all working very well. The problem
I'm having is that when I select something in a listbox when there are more
records in the form than can fit in the subform window without scrolling, my
subform listboxes go haywire and show selected items from the record below
them (if they show anything selected at all). If I look at the underlying
table, the field which stores the values from the listbox is correct, but the
listbox displays something else.
Here is the code that I'm using to add/insert records, and the modules it
calls:
**********
Private Sub Command1_Click()
Call AddItem(Form.CurrentRecord)
End Sub
**********
Private Function AddItem(ItemIndex As Integer)
DoCmd.SetWarnings False
If DMax("[line]", "[tblDocItemsTemp]") > 15 Then
MsgBox "You have reached the maximum of 15 line items. You cannot add/insert
a new line.",vbInformation+vbOkOnly,"System Message"
DoCmd.GoToRecord acActiveDataObject, , acGoTo, ItemIndex
Goto EndProcess
End If
If DMax("[line]", "[tblDocItemsTemp]") > ItemIndex Then
DoCmd.RunSQL "UPDATE tblDocItemsTemp SET line = line + 1 WHERE line > " &
ItemIndex & ";"
End If
DoCmd.RunSQL "INSERT INTO tblDocItemsTemp (line) VALUES (" & ItemIndex + 1 &
");"
Me.RecordSource = "SELECT tblDocItemsTemp.* FROM tblDocItemsTemp ORDER BY
tblDocItemsTemp.line;"
Me.Requery
Call ProcessRecords
DoCmd.GoToRecord acActiveDataObject, , acGoTo, ItemIndex + 1
EndProcess:
DoCmd.SetWarnings True
End Function
**********
Function ProcessRecords()
Dim z As Integer
For z = 1 To 15 ' ---> I only allow for 15 lines in the entry form.
If IsNull(DLookup("[line]", "[tblDocItemsTemp]", "[line] = " &
Me.CurrentRecord + 1 & "")) = True Then
z = 15
GoTo EndProcess
End If
DoCmd.GoToRecord acActiveDataObject, , acGoTo, z
Call DepartmentRebuild
EndProcess:
Next z
Me.Requery
End Function
**********
Private Function DepartmentRebuild()
Dim rs As Recordset, i As Integer, w As Integer, x As Integer, y As Integer,
tmpstring As String, tmpstring2() As Integer, AreaName() As String,
DepartmentName() As String, varitem As Variant
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblDepartmentIDs;")
x = 1
ReDim tmpstring2(x)
ReDim Preserve DepartmentName(x)
For w = 0 To Me.department_no.ListCount - 1
Me.department_no.Selected(w) = False
Next w
Debug.Print "Line: " & Me.line & " - Department List: " & Me.applies_to
With rs
If IsNull(Me.applies_to) = True Then
GoTo NoData
End If
For y = 1 To Len(Me.applies_to)
tmpstring = Mid(Me.applies_to, y, 1)
tmpstring2(x) = tmpstring2(x) & tmpstring
If tmpstring = " " Then GoTo SkipProcess
If tmpstring = "," Then
DepartmentName(x) = DLookup("[description]",
"[tblDepartmentIDs]", "[id_num] = " & tmpstring2(x) & "")
x = x + 1
ReDim Preserve tmpstring2(x)
ReDim Preserve DepartmentName(x)
End If
If y = Len(Me.applies_to) Then
DepartmentName(x) = DLookup("[description]",
"[tblDepartmentIDs]", "[id_num] = " & tmpstring2(x) & "")
For i = 1 To x
For w = 0 To Me.department_no.ListCount - 1
If Me.department_no.ItemData(w) = DepartmentName(i) Then
Me.department_no.Selected(w) = True
w = Me.department_no.ListCount - 1
End If
Next w
Next i
End If
GoTo SkipProcess
SkipProcess:
Next y
NoData:
.MoveNext
tmpstring = ""
End With
EndProcess:
rs.Close
End Function
**********
I have a hidden field on my form called applies_to which stores a string
based on whatever the user selects in the multi-select listbox. The string is
a list of department ID numbers separated by commas which I then parse
through the DepartmentRebuild function, which selects the corresponding items
in the listbox. The applies_to field shows the correct data for each record,
but the listboxes don't match if the number of records is high enough to
force the subform to have to scroll. It's very strange. Is there anything I
can do to help ensure that the listboxes show the correct data? It's very
confusing for me, and if I kick this release to my end users, they're never
going to understand what's going on.