PDA

View Full Version : [SOLVED] Listbox last row Visibility



Mahahaava
12-15-2008, 02:18 AM
Hi all!

I have a strange problem when populating listboxes:

If I populate the listbox using:


FormName.ListBoxName.List()=ArrayName
Everything is dandy but if I use:


For i = LBound(ArrayName, 1) To UBound(ArrayName, 1)
Me.ListBoxName.AddItem (ArrayName(i, 0))
For j = 1 To 7
Me.ListBoxName.List(i, j) = (ArrayName(i, j))
Next j
Next i
then if the "list" is longer than the "box" and I scroll to the bottom, the last row of data is hidden. It's there and I can access it using the arrow-keys but not using the mouse...

Why is this? I need to use the latter method occasionally so it kind of matters...

TIA

Petri

Bob Phillips
12-15-2008, 02:32 AM
I cannot replicate the problem. Can you post your workbook?

Mahahaava
12-15-2008, 03:39 AM
Hi,

thanks for the quick reply!

I'm afraid I cannot post the whole workbook as it's over 3 MB but here are 2 screenshots one done with AddITem and the other using the List() -method. A bit more info:

I've used a CListBoxHeader ClassModule to control the listbox headers and I also have a MouseScroll function implemented in the ListBox. Maybe these have an adverse affect. I'll attach these as well.

Another reason for not attaching the whole workbook is that you wouldn't be able to use it as it's a NW-application and won't start if all external modules aren't present. The Array used is actually compiled from several different workbooks...

This is my complete Init-sequence:


Private Sub UserForm_Initialize()
HideX EAluettelo
LuetteloNimi = "EAKoulutus"
Dim EAFields As Variant
Dim Errori As Boolean
Dim oLB As clsListBoxHeader
Dim aHeaders As Variant
Dim Apuarray As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Hnumber As String
Dim Staffields As Variant
Dim BirthDay As Integer
Dim Kustpaikka As Integer
Me.ListBoxEAlista.ColumnCount = 8
Me.ListBoxEAlista.ColumnWidths = "40;170;72;40;42;0;72" ' Kouluttaja mukana, piilossa
aHeaders = Array("Hnro", "Nimi", "Synt", "Kust", "Kurssi", "Kouluttaja", "Aika", "Kertaus")
Set oLB = New clsListBoxHeader
oLB.Create Me.ListBoxEAlista, aHeaders
oLB.BackColor = RGB(0, 255, 255)
oLB.BorderColor = RGB(0, 0, 255)
oLB.BorderStyle = 1
oLB.ForeColor = RGB(0, 0, 255)
oLB.Bold = True
oLB.SpecialEffect = 0 '1
oLB.CloseUp = -5
oLB.FontSize = 8
oLB.FontName = "MS Reference Sans Serif" '"Arial"
Set oLB = Nothing
Me.Lukum??r?.BackColor = RGB(0, 255, 255)
Me.Lukum??r?.ForeColor = RGB(0, 0, 255)
Me.Lukum??r?.SpecialEffect = fmSpecialEffectBump
On Error GoTo VIRHE
EAFields = Array("Hnro", "Nimi", "Kurssi", "Kouluttaja", "Aika", "Kertaus", _
"S?hk?mies", "EaKurssiehdotus", "Kurssin parannustavoite")
If FilterOn Then
LueSuojeluData EAArray, EAFields, "EA-Koulutus.xls", "Poimitut", Errori
Else
LueSuojeluData EAArray, EAFields, "EA-Koulutus.xls", "Taulukko", Errori
End If
If Errori Then GoTo VIRHE
If EAArray(0, 0) = "Otsikko" Then
Me.ListBoxEAlista.Clear
Exit Sub
End If
LueTy?kirjanOtsikkorivi Staffields, "Henkil?kunta.xls", "Taulukkosivu"
BirthDay = Kentt?Nro(Staffields, "Syntym?aika")
Kustpaikka = Kentt?Nro(Staffields, "Kustannuspaikka")
Apuarray = EAArray
ReDim EAArray(LBound(Apuarray, 1) To UBound(Apuarray, 1), LBound(Apuarray, 2) _
To UBound(Apuarray, 2) + 2) As Variant
ArrayPituus = UBound(EAArray, 1)
For i = LBound(EAArray, 1) To UBound(EAArray, 1)
For j = 0 To 10
Select Case j
Case 0 To 1
EAArray(i, j) = Apuarray(i, j)
Case 2 ' syntym?aika
Hnumber = Apuarray(i, 0)
EAArray(i, j) = TietoHenkil?kuntataulukosta(Hnumber, BirthDay - 1)
Case 3 'kustannuspaikka
Hnumber = Apuarray(i, 0)
EAArray(i, j) = TietoHenkil?kuntataulukosta(Hnumber, Kustpaikka - 1)
Case Else
EAArray(i, j) = Apuarray(i, j - 2)
End Select
Next j
Next i
Me.ListBoxEAlista.Clear
'For i = LBound(EAArray, 1) To UBound(EAArray, 1)
' Me.ListBoxEAlista.AddItem (EAArray(i, 0))
' For j = 1 To 7
' Me.ListBoxEAlista.List(i, j) = (EAArray(i, j))
' Next j
'Next i
Me.ListBoxEAlista.List() = EAArray
SuljeTy?kirja "Henkil?kunta.xls"
Me.ListBoxEAlista.ListIndex = 0 ' Focus listan ekaan riviin.
Me.CB_Talleta.Visible = False
Me.CB_Sulje.Caption = "Sulje"
Application.ScreenUpdating = True
Exit Sub
VIRHE:
SuljeTy?kirja "Henkil?kunta.xls"
MsgBox "Ohjelman suoritus keskeytyy!", vbCritical, "Virhe: (Init EAluettelo)"
Application.ScreenUpdating = True
End Sub
Using AddItem:
https://cid-61528c132cbea9f2.skydrive.live.com/self.aspx/Public/AddItem.jpg
Using List-methid:
https://cid-61528c132cbea9f2.skydrive.live.com/self.aspx/Public/ArrayAdd.jpg
HTH

Petri

MouseScroll:

Option Explicit
'To be able to scroll with mouse wheel within Userform

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'To get hWnd long value of the UserForm
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim MyForm As UserForm

Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'To handle mouse events
Dim MouseKeys As Long
Dim Rotation As Long
Select Case LuetteloNimi
Case "EAKoulutus"
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536
'My Form s MouseWheel function
EAluettelo.MouseWheel Rotation
End If
Case "Tulity?"
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536
'My Form s MouseWheel function
Tulity?luettelo.MouseWheel Rotation
End If
Case Else
End Select
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam)
End Function

Public Sub WheelHook(PassedForm As UserForm)
'To get mouse events in userform
On Error Resume Next
Set MyForm = PassedForm
LocalHwnd = FindWindow("ThunderDFrame", MyForm.Caption)
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub WheelUnHook()
'To Release Mouse events handling
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
Set MyForm = Nothing
End Sub

Public Function LeftString(ByVal sText As String, ByVal sSeparator As String) As String
If Len(sText) > 2 Then
LeftString = Left(sText, InStr(1, sText, sSeparator) - 1)
End If
End Function

Public Function RightString(ByVal sText As String, ByVal sSeparator As String) As String
If Len(sText) > 2 Then
RightString = Right(sText, Len(sText) - InStr(1, sText, sSeparator))
End If
End Function


clsListBoxHeader:

Option Explicit
Private m_oHeader As MSForms.ListBox
Private m_oSource As MSForms.ListBox
Const THISCLASS = "[clsListBoxHeader] "

Public Sub Create(ByVal lstSource As MSForms.ListBox, ByVal HeadingRangeOrArray As Variant)
Dim iCol As Integer
Dim H As Variant
'Const OPTION_COLWIDTH = "12" 'Initial space if source has option Column
''' Voi Voi! Leveys on numerotavaraa!!! (Ainakin nyky??...)
Const OPTION_COLWIDTH = 12 'Initial space if source has option Column
On Error GoTo ErrorHandler
Set m_oHeader = lstSource.Parent.Controls.Add("forms.ListBox.1", , True)
Set m_oSource = lstSource
With m_oHeader
.Enabled = False
.ColumnHeads = False
.MultiSelect = fmMultiSelectSingle
.ListStyle = fmListStylePlain
m_oSource.ColumnHeads = False
'Inherit source column properties
If m_oSource.ListStyle = fmListStyleOption Then
.ColumnCount = 1 + m_oSource.ColumnCount
.ColumnWidths = OPTION_COLWIDTH & "," & m_oSource.ColumnWidths
iCol = 1
Else
.ColumnCount = m_oSource.ColumnCount
.ColumnWidths = m_oSource.ColumnWidths
End If
'Inherit source dimension properties
.Width = m_oSource.Width
.Height = m_oSource.FontSize
.Left = m_oSource.Left
.Top = m_oSource.Top
'Ensures listbox redraws correctly
'Seems to be required immediately after a Width or Height Change
'Not sure why or if this is a bug?
DoEvents
'Inherit source style properties
.BorderStyle = m_oSource.BorderStyle
.BorderColor = m_oSource.BorderColor
.BackColor = m_oSource.BackColor
.FontSize = m_oSource.FontSize
.ForeColor = m_oSource.ForeColor
.SpecialEffect = m_oSource.SpecialEffect
.FontName = m_oSource.FontName
'Rejiggle source listbox size and position
m_oSource.Top = m_oSource.Top + .Height
m_oSource.Height = m_oSource.Height - .Height
'Add headings
.AddItem ""
'If headings in spreadsheet range...
If TypeName(HeadingRangeOrArray) = "Range" Then
For Each H In HeadingRangeOrArray.Rows(1)
.List(0, iCol) = H
iCol = iCol + 1
Next H
Else
'If headings supplied programmatically as an array
For Each H In HeadingRangeOrArray
.List(0, iCol) = H
iCol = iCol + 1
Next H
End If
End With
Exit Sub
ErrorHandler:
Err.Raise Err.Number, THISCLASS & "Create", Err.Description
End Sub

Public Property Let BackColor(ByVal iRGB As Long)
If iRGB >= RGB(0, 0, 0) And iRGB <= RGB(255, 255, 255) Then
m_oHeader.BackColor = iRGB
Else
Err.Raise vbObjectError + 1001, THISCLASS & "BackColor", "Invalid property setting"
End If
End Property

Public Property Let BorderColor(ByVal iRGB As Long)
If iRGB >= RGB(0, 0, 0) And iRGB <= RGB(255, 255, 255) Then
m_oHeader.BorderColor = iRGB
Else
Err.Raise vbObjectError + 1001, THISCLASS & "BorderColor", "Invalid property setting"
End If
End Property

Public Property Let BorderStyle(ByVal iBS As Integer)
'MSForms.fmBorderStyle
If iBS = 0 Or iBS = 1 Then
m_oHeader.BorderStyle = iBS
Else
Err.Raise vbObjectError + 1001, THISCLASS & "BorderStyle", "Invalid property setting"
End If
End Property

Public Property Let ForeColor(ByVal iRGB As Long)
If iRGB >= RGB(0, 0, 0) And iRGB <= RGB(255, 255, 255) Then
m_oHeader.ForeColor = iRGB
Else
Err.Raise vbObjectError + 1001, THISCLASS & "ForeColor", "Invalid property setting"
End If
End Property

Public Property Let Bold(ByVal bBold As Boolean)
On Error Resume Next
m_oHeader.FontBold = True
End Property

Public Property Let SpecialEffect(ByVal iSE As Integer)
'If iSE > 0 (not flat), Borderline is automatically set to 0 (none)
If iSE >= 0 And iSE <= 6 Then
m_oHeader.SpecialEffect = iSE
Else
Err.Raise vbObjectError + 1001, THISCLASS & "SpecialEffect", "Invalid property setting"
End If
End Property

Public Property Let CloseUp(ByVal iY As Integer)
'If iY is positive, the list boxes are closer, if negative, they further apart
'A value of 2 seems to line them up exactly with no gaps
If iY >= -10 And iY <= 2 Then
With m_oHeader
m_oSource.Top = m_oSource.Top - iY
m_oSource.Height = m_oSource.Height + iY
End With
Else
Err.Raise vbObjectError + 1001, THISCLASS & "CloseUp", "Invalid property setting"
End If
End Property

Public Property Let FontSize(ByVal iFS As Integer)
If iFS >= 8 And iFS <= 14 Then
With m_oHeader
.FontSize = iFS
.Height = .FontSize * 1.2 'add some space above and below
.Top = m_oSource.Top - .Height
End With
Else
Err.Raise vbObjectError + 1001, THISCLASS & "FontSize", "Invalid property setting"
End If
End Property

Public Property Let FontName(ByVal sFN As String)
Dim cbar As CommandBarComboBox
Dim bFound As Boolean
Dim i As Integer
Set cbar = Application.CommandBars.FindControl(ID:=1728)
For i = 1 To cbar.ListCount
If sFN = cbar.List(i) Then bFound = True
Next i
If bFound Then
With m_oHeader
.FontName = sFN
End With
Else
Err.Raise vbObjectError + 1001, THISCLASS & "FontName", "Invalid property setting"
End If
End Property

Private Sub Class_Terminate()
Set m_oHeader = Nothing
Set m_oSource = Nothing
End Sub

Bob Phillips
12-15-2008, 03:57 AM
Sorry, but without a workbook I don't see us getting anywhere, I do not have the time to recreate the file/problem, even if I could.

Mahahaava
12-15-2008, 04:37 AM
Hi,

OK I made a quick and dirty version of the XLS, It will AutoExcecute (Module EAPoiminta -- Auto_Open). In the EALuettelo Form in Init the AddItem method is now active and the last row will remain hidden in the ListBox..

Anyone have any idea why the method of populating the listbox results in different properties of the listbox? I haven't a clue!

/Petri

11140

Mahahaava
12-15-2008, 05:41 AM
OK I tested a bit futher:

If I don't read the ListBox headers using the classmodule, both population methods work OK but if I feed the headers, only using the List()=Array method results in a "clean" listbox... Weird?

/Petri

Mahahaava
12-15-2008, 05:59 AM
Here's a new version with two CommandButtons to test the difference:

Array will populate the box using ...List()=Array
AddItem will populate using AddITem(i,j)

/Petri

11142

PS EXCEL 2003!!(Sorry 'bout not sayng this earlier!)

Mahahaava
12-17-2008, 04:39 PM
Hi,

I asked this once already but probably wasn't quite prepared enough... Here goes again. If I populate my listbox from an Array using:

ListboxName.List() = ArrayName, everything works fine and dandy. If however I populate the same listbox from the same array with AddItem I cannot see or access the last row with the mouse (Down arrow will reach it):

For i = LBound(EAArray, 1) To UBound(EAArray, 1)
Me.ListBoxEAlista.AddItem (EAArray(i, 0))
For j = 1 To 7
Me.ListBoxEAlista.List(i, j) = (EAArray(i, j))
Next j
Next i
I use Listbox Header ClassModule, which is certainly the cause of this but why would the behavior of the listbox be dependant on the method of population?

I've attached an xls file with a listbox, data and 2 buttons, AddItem and Array.

My actual question is if there's anything to be done to get the AddItem way to work? I won't dump the ClassModule unless I get something better to replace it...

Thanks,

Petri
11181

Paul_Hossler
12-17-2008, 05:54 PM
In the properties for your ListBoxEAlista, make Column Heads = False, and see if that gives what you want

Paul

Mahahaava
12-17-2008, 06:10 PM
Thank You! That did the Trick!

:beerchug:

Cheers,

Petri

lucas
12-17-2008, 07:28 PM
Threads merged