How do I allow for Scrolling on an Array of Data?

[PSUIVERSON]

I have an application I wrote that ties into a very large database. Depending on the account number it retrieves the detail behind a summarized number. So maybe the number is $100,000 for cash. You click on detail and it goes to the ACCESS database and returns all the detail that makes up that $100,000. I wrote a control array to handle this and outputted it to labels based on the number it returned. The problem is that some of the accounts have an inordinate amount of detail that needs to be placed in a scroll down box. It runs right off the page!! I know this is probably simple as I am a finance guy who is pretty good with VBA and VB but not a programmer by any means. Someone tell me how to capture this data in a scrolling format on the form? (Note: I played with the scrollbar control but can't figure it out ALSO - If you think I am doing something wrong and could do it better please let me know) Thanks in advance!!!

MY CODE:

Private Sub Form_Load()
Dim areaVal, fundVal, orgnVal, acctDesc, acctNum As String
Dim curDate As String

Dim adoConnection As ADODB.Connection
Dim rst As ADODB.Recordset
Dim connectString As String

' Create a new connection
Set adoConnection = New ADODB.Connection

' Creat a new Recordset
Set rst = New ADODB.Recordset

' Build connection string
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\SOM Files\FINSYS WORK\SOMM_ConversionProcess.mdb"

adoConnection.Open connectString

' Get account Description
rst.Open "Sponsprj", adoConnection

areaVal = frmFINSYS.txtAREA
fundVal = frmFINSYS.txtFUND
orgnVal = frmFINSYS.txtORGN
acctDesc = frmFINSYS.lblDesc
acctNum = frmFINSYS.lblAccount
curDate = "As of " & rst!Date

rst.Close

' Load Detail

lblAccount.Caption = acctNum
lblDesc.Caption = acctDesc
' lblDate.Caption = curDate

' Open Up FINREC for Detail
rst.Open "FINREC", adoConnection

Dim suffixVal(0 To 50) As String
Dim suffixDescVal(0 To 50) As String
Dim fiscytdVal(0 To 50) As String
Dim enctdVal(0 To 50) As String
Dim budytdVal(0 To 50) As String

Dim count As Integer

i = 0
count = 0

rst.MoveFirst
Do While Not rst.EOF
If rst!FUND = fundVal And rst!AREA = areaVal And rst!ORGN = orgnVal Then
suffixVal(i) = rst!suffix
suffixDescVal(i) = rst!suffDesc
fiscytdVal(i) = FormatCurrency(rst!fiscYTD)
enctdVal(i) = FormatCurrency(rst!encTD)
budytdVal(i) = FormatCurrency(rst!CURRBUD)
i = i + 1
End If
rst.MoveNext
Loop

count = i

lblSuffix(0).Caption = suffixVal(0)
lblSuffDesc(0).Caption = suffixDescVal(0)
lblYTD(0).Caption = fiscytdVal(0)
lblENC(0).Caption = enctdVal(0)
lblCB(0).Caption = budytdVal(0)

For i = 1 To count

Load lblSuffix(i)
Load lblSuffDesc(i)
Load lblYTD(i)
Load lblENC(i)
Load lblCB(i)

lblSuffix(i).Top = lblSuffix(i - 1).Top + lblSuffix(0).Height
lblSuffDesc(i).Top = lblSuffDesc(i - 1).Top + lblSuffDesc(0).Height
lblYTD(i).Top = lblYTD(i - 1).Top + lblYTD(0).Height
lblENC(i).Top = lblENC(i - 1).Top + lblENC(0).Height
lblCB(i).Top = lblCB(i - 1).Top + lblCB(0).Height

lblSuffix(i).Caption = suffixVal(i)
lblSuffDesc(i).Caption = suffixDescVal(i)
lblYTD(i).Caption = fiscytdVal(i)
lblENC(i).Caption = enctdVal(i)
lblCB(i).Caption = budytdVal(i)

lblSuffix(i).Visible = True
lblSuffDesc(i).Visible = True
lblYTD(i).Visible = True
lblENC(i).Visible = True
lblCB(i).Visible = True

Next i

Set rst = Nothing

End Sub

 

[CasperTFG]

Put your labels into a frame. and add a scroll bar on the frame. Then you need to add the following code.
[tt]
lblALL_LABELS.Container = Frame1
[/tt]
Then you also have to set so that if the number of labels goes off the Frame, then you show the scroll bar and adjust the values on the scroll bar.
[tt]
If i > 12 Then
hScroll1.Visible = True
hScroll1.MaxValue = i - 10
End If
[/tt]
Then you need code in the hScroll so that when they scroll you move the labels. Here is some code I hade for displaying drives in such a fashion, you jsut have to convert for your use.
[tt]
Public Sub MoveDrives(ByVal Index As Long)
Dim ItemCount As Long
Dim InnerItemCount As Long

InnerItemCount = 2
For ItemCount = 2 To (sbDrive.Count - 1)
If ItemCount < Index Then
'Drive Label
.lblDriveName(ItemCount).Visible = False
'Drive Label Info
.lblDriveNameDetails(ItemCount).Visible = False
'Drive ObjectID Text box
.txtDrive(ItemCount).Visible = False
'Slider Bar
.sbDrive(ItemCount).Visible = False
'Progress Bar
.pbDrive(ItemCount).Visible = False
Else
If InnerItemCount <= 6 Then
'Drive Label
With .lblDriveName(ItemCount)
.Move 120, (-600 + (480 * InnerItemCount)), 375, 255
.Visible = True
End With

'Drive Label Info
With .lblDriveNameDetails(ItemCount)
.Move 7440, (-600 + (480 * InnerItemCount)), 1575, 255
.Visible = True
End With

'Drive ObjectID Text box
With .txtDrive(ItemCount)
.Move 6600, (-600 + (480 * InnerItemCount)), 735, 285
.Visible = True
End With

'Slider Bar
With .sbDrive(ItemCount)
.Move 480, (-720 + (480 * InnerItemCount)), 6015, 135
.Visible = True
End With

'Progress Bar
With .pbDrive(ItemCount)
.Move 480, (-600 + (480 * InnerItemCount)), 6015, 255
.Visible = True
End With
Else
'Drive Label
.lblDriveName(ItemCount).Visible = False
'Drive Label Info
.lblDriveNameDetails(ItemCount).Visible = False
'Drive ObjectID Text box
.txtDrive(ItemCount).Visible = False
'Slider Bar
.sbDrive(ItemCount).Visible = False
'Progress Bar
.pbDrive(ItemCount).Visible = False

End If
InnerItemCount = InnerItemCount + 1
End If
Next ItemCount

End Sub
[/tt]

Craig, mailto:sander@cogeco.ca

In the computer industry, there are three kinds of lies:
lies, damn lies, and benchmarks.

 

[PSUIVERSON]

Thanks for the effort man. I'll give it the old college try and let you know how I make out...I'm playing with FlexGrids right now...

 

[PSUIVERSON]

Thanks bro. This is what i went with. Used Flex Grids:

Private Sub Form_Load()

msgFlex.ColWidth(0) = 1
msgFlex.ColWidth(1) = 1440
msgFlex.ColWidth(2) = 3500
msgFlex.ColWidth(3) = 1440
msgFlex.ColWidth(4) = 1440
msgFlex.ColWidth(5) = 1440

msgFlex.Row = 0
msgFlex.Col = 1
msgFlex.Text = &quot;Exp Object&quot;

msgFlex.Row = 0
msgFlex.Col = 2
msgFlex.Text = &quot;Rev Source&quot;

msgFlex.Row = 0
msgFlex.Col = 3
msgFlex.Text = &quot;Year To Date&quot;

msgFlex.Row = 0
msgFlex.Col = 4
msgFlex.Text = &quot;Encumbrances&quot;

msgFlex.Row = 0
msgFlex.Col = 5
msgFlex.Text = &quot;Current Budget&quot;

msgFlex.ColAlignment(1) = 0
msgFlex.ColAlignment(2) = 2
msgFlex.ColAlignment(3) = 7
msgFlex.ColAlignment(4) = 7
msgFlex.ColAlignment(5) = 7


Dim areaVal, fundVal, orgnVal, acctDesc, acctNum As String
Dim curDate As String

Dim adoConnection As ADODB.Connection
Dim rst As ADODB.Recordset
Dim connectString As String

' Create a new connection
Set adoConnection = New ADODB.Connection

' Creat a new Recordset
Set rst = New ADODB.Recordset

' Build connection string
connectString = &quot;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\SOM Files\FINSYS WORK\SOMM_ConversionProcess.mdb&quot;

adoConnection.Open connectString

' Get account Description
rst.Open &quot;Sponsprj&quot;, adoConnection

areaVal = frmFINSYS.txtAREA
fundVal = frmFINSYS.txtFUND
orgnVal = frmFINSYS.txtORGN
acctDesc = frmFINSYS.lblDesc
acctNum = frmFINSYS.lblAccount
curDate = &quot;As of &quot; & rst!Date

rst.Close

' Load Detail

lblAccount.Caption = acctNum
lblDesc.Caption = acctDesc
lblDate.Caption = curDate

' Open Up FINREC for Detail
rst.Open &quot;FINREC&quot;, adoConnection

Dim suffixVal(0 To 50) As String
Dim suffixDescVal(0 To 50) As String
Dim fiscytdVal(0 To 50) As String
Dim enctdVal(0 To 50) As String
Dim budytdVal(0 To 50) As String

Dim count As Integer

i = 0
count = 0

rst.MoveFirst
Do While Not rst.EOF
If rst!FUND = fundVal And rst!AREA = areaVal And rst!ORGN = orgnVal Then
suffixVal(i) = rst!suffix
suffixDescVal(i) = rst!suffDesc
fiscytdVal(i) = FormatCurrency(rst!fiscYTD)
enctdVal(i) = FormatCurrency(rst!encTD)
budytdVal(i) = FormatCurrency(rst!CURRBUD)
i = i + 1
End If
rst.MoveNext
Loop

count = i

For i = 0 To count

' Suffix Value
msgFlex.Row = i + 1
msgFlex.Col = 1
msgFlex = suffixVal(i)
' SuffDesc Value
msgFlex.Row = i + 1
msgFlex.Col = 2
msgFlex = suffixDescVal(i)
' FiscYtd Value
msgFlex.Row = i + 1
msgFlex.Col = 3
msgFlex = fiscytdVal(i)
' ENCTD Value
msgFlex.Row = i + 1
msgFlex.Col = 4
msgFlex = fiscytdVal(i)
' BUDYTD Value
msgFlex.Row = i + 1
msgFlex.Col = 5
msgFlex = fiscytdVal(i)

Next i

Set rst = Nothing

End Sub