?
Solved

listVIEW question...

Posted on 2010-08-30
35
Medium Priority
?
666 Views
Last Modified: 2012-05-10
I am using a listVIEW to show the status of differnent items progress.
I would like to have something like

data  data date CHECKMARK  X  CHECKMARK

The 4th, 5th, 6th columns could be an X or a check, depending if the item is complete or not.
Is there a way to control the font by column or "cell". Ideally, I would like to have the wingding font and use chr(162 and 163)
Or is there a font that is nice easy readalbe letters, and then the x and check similiar to wingdings?
using excel 2007
Thanks!


0
Comment
Question by:Bruj
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 15
  • 12
  • 6
35 Comments
 
LVL 45

Expert Comment

by:patrickab
ID: 33565673
Bruj,

Please upload your file.

Patrick
0
 
LVL 34

Expert Comment

by:Norie
ID: 33567515
Bruj

I'm no expert with listviews, I can populate them and that's about it so far, but I can't find anything that will allow you to have different fonts for cells/rows/columns.

A lot of people ask a similar question about listboxes/comboboxes and again the answer is it isn't possible.

I might be missing something though - I'll look into it further.
0
 

Author Comment

by:Bruj
ID: 33573233

OK, I have sucess!! I have found out how to use icons in the subitems!

I have included my workbook as an example.

Change code for image location to where you save the BMPs

It shows alot of the listview processes and all

Now... I just need to figure out how to CENTER the ICONS in the subitems... Another question for this one!

listviewSample.xlsm
checkmark.bmp
xmark.bmp
0
Simplifying Server Workload Migrations

This use case outlines the migration challenges that organizations face and how the Acronis AnyData Engine supports physical-to-physical (P2P), physical-to-virtual (P2V), virtual to physical (V2P), and cross-virtual (V2V) migration scenarios to address these challenges.

 
LVL 45

Expert Comment

by:patrickab
ID: 33574754
Bruj,

Why are you using bitmaps to achieve a tick/checkmark and a cross? It is completely unnecessary to do that. All you need to do is use Wingdings font and you will find the tick and the cross almost at the end of the font - using Start/Run/Charmap. Having copied and pasted them each into a cell of their own you can change the point size, centre them and colour them at you want. They behave just like any other font. See attached file for an example.

Patrick
wingdings-tick-cross.xls
0
 
LVL 45

Expert Comment

by:patrickab
ID: 33575019
WallyMod,

BTW - if you feel that I should not have 'Object'ed and the question should be closed anyway, please feel free to do so. I only pressed the Object button to as to ensure the questioner saw my solution rather than just ignore it.

Patrick
0
 

Author Comment

by:Bruj
ID: 33576474
Patrickab,
That DOES work in a cell, but from what I have been able to find, you cannot change the font for LISTVIEW for the different subitems. Since I also do have text (item, and subitems 1 & 2) changing the font wont work (unless there IS a way to change fonts for just certain subitems..)
That would be the BEST way! Maybe I should have still left it open, as that is what I really want!

Thanks
Bruce
0
 
LVL 45

Expert Comment

by:patrickab
ID: 33576518
Bruce,

The trouble is I don't know what you mean by LISTVIEW. Do please explain.

Patrick
0
 

Author Comment

by:Bruj
ID: 33576902
Maybe some way with API calls....???
0
 
LVL 34

Expert Comment

by:Norie
ID: 33576980
Patrick

A ListView is a control available via Additional Controls (userform... or More Controls (worksheet).

Kind of like a listbox but with some added features.
0
 
LVL 45

Expert Comment

by:patrickab
ID: 33578255
>A ListView is a control available via Additional Controls

Got it now - thanks. I can't see a way of changing the font in that control - but then perhaps I've missed something.
0
 

Author Comment

by:Bruj
ID: 33578912
Patrickab,  if you download my wb, it shows some ways of using Listview. It is really a pretty sweet control!. It does multicolumns really well, it sorts by column clicking, it will let you put grids on, it will let you color and bold different items you can multi select you can put icon in the headers and in the subitems (think almost like and array) It is almost the perfect tool for alot of select things! Just not centering icon or changing the font for invevidual subitems.

WOW, after all this time and all the help you have given me, I get a chance ti introduce YOU to something! Cool!
0
 
LVL 34

Expert Comment

by:Norie
ID: 33578974
bruj

The workbook you attached doesn't actually seem to work.
0
 
LVL 45

Expert Comment

by:patrickab
ID: 33579274
Bruce,

That's what I love about this site. One is able to both help and to learn in the process. I have never even seen the ListView Control before let alone use it. I must experiment with it as it sounds realy rather helpful.

Patrick
0
 

Author Comment

by:Bruj
ID: 33583670
imnorie, Sorry...
What you need to do is to go to userform1 initialazation, change change the 2 line:
.ListImages.Add 1, "P1", LoadPicture("e:\checkmark.bmp") 'my green check
        .ListImages.Add 2, "P2", LoadPicture("e:\xmark.bmp") 'my red X

to reflect where you have these files stored.

It should work then
0
 
LVL 34

Expert Comment

by:Norie
ID: 33583709
I can't even access the code.:)

Anyway the error message(s) I'm getting wouldn't be caused by having incorrect path/filenames.
0
 

Author Comment

by:Bruj
ID: 33583781
What error are you getting? and when?
I got a "file not found"
0
 
LVL 34

Expert Comment

by:Norie
ID: 33586451
Some error to do with object libraries/references or something.

The file actually killed Excel and I had to use Task Manager to shut it down.

To be honest from what I've seen of it whatever is going on is a bit complicated for a sort of
'introduction' to listviews.

I did actually manage to see some of the code the first time I opened it, don't know why.

There seemed to be some Windows API code, there were also some other 'non-standard'
things going on eg common dialog control.

PS I know that really is a standard control in VB, but it's not used much in VBA.

Where did you find the file?

Perhaps I'll have more luck downloading it from the original source.

Or if you created the file yourself, did you get any help from anywhere?

If you did perhaps you could post links, references etc.
0
 

Author Comment

by:Bruj
ID: 33588413
I am doing a lot with the listviews, but that is the way I do want it to work in my final design.
The form is actually going to be be used to replace about 6 forms I currently have. I wanted to take the approach of a single form instead of several and I was having issues with the old form still showing when it was not supposed to, and I feel it is more graceful
I did get some of the code snippets from the net (like the sort portion from http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20161504.html ) but most of it I rolled my self after looking at many examples. This is also MY first use of Listview and I love the look and feel of it!
Most of the buttons are for testing right now and will actually be replaced with code calls to whichform
The references I am using are:
vba for apps
Microsoft Excel 12.0 object library
ole automation
ms office 12.0 object library
ms forms 2.0 object library
microsoft windows common controls 6.0 (sp6)
This is working on both a vista 62 machine as well as an xp system

I am NOT using the totestandadd module, that is to have control over the position of the msgbox, but does not seem to work:(
The only other APIs I am using are in mLVSort (the code I borrowed) and it anctuall fixes the way listview sort handles numbers and dates

I have attached the code seperatly and well as the userform1 and I have reattached the workbook.

'**************************************
'userform1 code
Public CurrForm As Integer
Public gUserName
Public gPassword

Private lvHeader1(6) As String
Private lvHeader2(12) As String
Private lvHeader3(1) As String
'Private ImageList1 As New ImageList
Private Sub UserForm_Initialize()
 Application.EnableCancelKey = xlErrorHandler 'Disable Cancel
 'Need to remove redX and set icon on title bar, as well as having titlebar.text varible driven
 
'Make the headers for the listviews
    lv_MakeHeaders
    ListView1.CheckBoxes = False
    ListView1.FullRowSelect = True
    ListView1.MultiSelect = True

    ListView2.CheckBoxes = False
    ListView2.FullRowSelect = True
    ListView2.MultiSelect = True

'Add images to imagelist (need to add imagelist to form object)
    With ImageList1
        .ListImages.Add 1, "P1", LoadPicture("e:\checkmark.bmp") 'my green check
        .ListImages.Add 2, "P2", LoadPicture("e:\xmark.bmp") 'my red X
    End With
    
  '  Dim intLoop As Integer 'should be able to remove
    Dim objItem As ListItem
    
    'Tie the imagelist to the ListView2 obj
    Set ListView2.SmallIcons = ImageList1

'fill each listview - Need to modulize for portability
    fillListView objItem
    
    'release objItem
    Set objItem = Nothing
    
  '  q = 1  - Used for testing, should be romoved when completed
  
 ' Set each ListView to Report mode
    ListView1.View = lvwReport
    ListView2.View = lvwReport
    ListView3.View = lvwReport

End Sub




'*******************************************************
'Command Procedures
'*******************************************************
Private Sub cmdClear_Click()
    m = UserForm1.ListView1.Width
    For x = m To m + 20
        UserForm1.ListView1.Width = x
        MsgBox x
    Next
End Sub

Private Sub cmdHideAll_Click()
'Hide all user inputs
    whichform cHideAll
End Sub

Private Sub cmdLogin_Click()
'Shows Login Screen
    whichform cLogin
End Sub

Private Sub cmdProcess_Click()
    'Shows Processing Selections
    whichform cProcess
End Sub

Private Sub cmdQuit_Click()
'Quits Form
    Unload Me
End Sub

Private Sub cmdResume_Click()
'This needs to be created, right now using button as a documenting of ListView tool launch
    Debug.Print "Listview1"
    For i = 1 To UserForm1.ListView1.ColumnHeaders.Count
        Debug.Print UserForm1.ListView1.ColumnHeaders(i).Text & " , , "; UserForm1.ListView1.ColumnHeaders(i).Width
    Next
    
    Debug.Print "Listview2"
    For i = 1 To UserForm1.ListView2.ColumnHeaders.Count
        Debug.Print UserForm1.ListView2.ColumnHeaders(i).Text & " , , "; UserForm1.ListView2.ColumnHeaders(i).Width
    Next
    Debug.Print "Listview3"
    For i = 1 To UserForm1.ListView3.ColumnHeaders.Count
        Debug.Print UserForm1.ListView3.ColumnHeaders(i).Text & " , , "; UserForm1.ListView1.ColumnHeaders(i).Width
    Next

End Sub

Private Sub cmdSeleContainer_Click()
'Shows the Container Selection screen
    whichform cSeleContainer
End Sub
Private Sub cmdSelect_Click()
    Dim tempcnt As Long
    Dim w As String
    Dim z As String
    Dim x As String
    Dim c As String
    tempcnt = 0
    w = ""
    z = ""
    x = ""
    c = ""
    If CurrForm = 2 Then
        Set mobjListItem2 = ListView1

        With ListView1
            lLvHwnd = .hWnd
            '.Visible = False             'For speed. Need to remove the line in VBA
            ' lSelectedItems = SendMessage(lLvHwnd, LVM_GETSELECTEDCOUNT, 0, ByVal 0&)
            lItemIndex = -1
            For sThisItem = 1 To ListView1.ListItems.Count
                '    lItemIndex = SendMessage(lLvHwnd, LVM_GETNEXTITEM, lItemIndex, ByVal LVNI_SELECTED)
                If .ListItems(sThisItem).Selected Then
                    tempcnt = tempcnt + 1

                    w = w & vbCrLf & .ListItems(sThisItem).Selected
                    x = x & vbCrLf & .ListItems(sThisItem).Text
                    z = z & vbCrLf & .ListItems(sThisItem).SubItems(1)
                    c = c & vbCrLf & .ListItems(sThisItem).SubItems(4)
                End If
            Next
            '  .Visible = True              'For speed. Need to remove the line in VBA
        End With
        strstring = ListView1.SelectedItem

    End If
    If CurrForm = 3 Then
        Set mobjListItem2 = ListView2

        With ListView2
            lLvHwnd = .hWnd
            lItemIndex = -1
            For sThisItem = 1 To ListView2.ListItems.Count
                If .ListItems(sThisItem).Selected Then
                    tempcnt = tempcnt + 1
                    w = w & vbCrLf & .ListItems(sThisItem).Selected
                    x = x & vbCrLf & .ListItems(sThisItem).Text
                    z = z & vbCrLf & .ListItems(sThisItem).SubItems(1)
                    c = c & vbCrLf & .ListItems(sThisItem).SubItems(1)
                End If
            Next
        End With
    End If
    If CurrForm = 4 Then
        Set mobjListItem2 = ListView3

        With ListView3
            lLvHwnd = .hWnd
            lItemIndex = -1
            For sThisItem = 1 To ListView3.ListItems.Count
                If .ListItems(sThisItem).Selected Then
                    tempcnt = tempcnt + 1
                    w = w & vbCrLf & .ListItems(sThisItem)
                    c = c & vbCrLf & w
                End If
            Next
        End With
    End If
    'For testing and confirmation Will remove and then make results available using userform1.variable name
    MsgBox "You have Selected " & tempcnt & " items" & vbCrLf & "You selected: " & c


End Sub

Private Sub cmdSelectUser_Click()
    whichform cSeleUser

End Sub

Private Sub cmdShowProgress_Click()
    whichform cShowProgress
End Sub

'******************************
'Listview Sorting control
'******************************
Private Sub listview1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    LVSortColumns ListView1, ColumnHeader
End Sub
Private Sub listview2_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    LVSortColumns ListView2, ColumnHeader
End Sub
Private Sub listview3_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    LVSortColumns ListView3, ColumnHeader
End Sub
Function LVSortColumns(LVSort As ListView, LVColumnHeader As ColumnHeader) As Long
    On Error GoTo ErrFailed
    With LVSort
        'HACK: Protects against an occassional 'division by zero' general protection fault when sorting an empty listview
        If .ListItems.Count > 0 Then
            ' .Visible = False        'For speed. Need to remove the line in VBA
            .SortKey = LVColumnHeader.Index - 1
            .SortOrder = 1 - LVSort.SortOrder
            .Sorted = True
            '.Visible = True         'For speed. Need to remove the line in VBA
        End If
    End With
    Exit Function
ErrFailed:
    Debug.Assert False
    LVSortColumns = Err.Number
    On Error Resume Next
End Function



'***************************************
'Click Procedures
'***************************************
Private Sub ListView1_DblClick()
    'Launches selection code, allows user to double click in listview1 to select
    cmdSelect_Click
End Sub
Private Sub ListView2_DblClick()
    'Launches selection code, allows user to double click in listview2 to select
        cmdSelect_Click
End Sub
Private Sub ListView3_DblClick()
    'Launches selection code, allows user to double click in listview3 to select

    cmdSelect_Click
End Sub


'************************************************
'Configuring variables
'************************************************
Sub lv_MakeHeaders()
    With ListView1.ColumnHeaders
        .Add , , "Date", 50
        .Add , , "Submitter", 75, lvwColumnCenter
        .Add , , "System Name", 90, lvwColumnCenter
        .Add , , "SysPrin", 60, lvwColumnCenter
        .Add , , "Container Number", 95, lvwColumnCenter
        .Add , , "QTY", 30, lvwColumnCenter
        .Add , , "ASAP", 35
    End With
    With ListView2.ColumnHeaders
        .Add , , "Container ", 80
        .Add , , "CM MAC ", 75, lvwColumnCenter
        .Add , , "EMTA MAC ", 75, lvwColumnCenter
        .Add , , "CSG ", 25, lvwColumnCenter
        .Add , , "BACC ", 35, lvwColumnCenter
        .Add , , "FRSNCA03PS0 ", 65, lvwColumnCenter
        .Add , , "FTFRCAAMPS0 ", 65, lvwColumnCenter
        .Add , , "HYWRCAZRPS0 ", 70, lvwColumnCenter
        .Add , , "RTPKCABTPS0 ", 65, lvwColumnCenter
        .Add , , "SNFGCAHBPS0 ", 65, lvwColumnCenter
        .Add , , "SNJSCABAPS0 ", 65, lvwColumnCenter
        .Add , , "Safari ", 35, lvwColumnCenter
        .Add , , "EAS ", 25, lvwColumnCenter
        .Add , , "Tracker ", 40, lvwColumnCenter
        '.Add , , "Listview3", 0
        '.Add , , "User ", 50, lvwColumnCenter
    End With
    With ListView3.ColumnHeaders
        .Add , , "User", 75
    End With
End Sub
Function fillListView(objItem As ListItem) As Long
    Dim lr As Long
    mysheet = "Sheet1 (2)"
    lr = FindLastrow("Sheet1 (2)")
    For i = 3 To lr
        If ThisWorkbook.Sheets(mysheet).Cells(i, 1) <> "" Then
            If ThisWorkbook.Sheets(mysheet).Cells(i, 7) = "" Then
                Set objItem = ListView1.ListItems.Add(, , ThisWorkbook.Sheets(mysheet).Cells(i, 1))
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 2)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 3)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 4)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 5)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 9)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 11)
                
               ' If containers is needed ASAP, change to RED forecolor
                If UCase(ThisWorkbook.Sheets(mysheet).Cells(i, 11)) = UCase("yes") Then
                    ListView1.ListItems(ListView1.ListItems.Count).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).Bold = True
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(1).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(2).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(3).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(4).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(5).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(6).ForeColor = RGB(255, 0, 0)
                End If

            End If
        End If


    Next
    mysheet = "Sheet2"
    lr = FindLastrow("Sheet2")
    For i = 2 To lr
        Set objItem = ListView2.ListItems.Add(, , ThisWorkbook.Sheets(mysheet).Cells(i, 1))
        objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 2)
        objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 3)
         
         
         'Set subitems to icon, need to figure out how to center icon
        objItem.ListSubItems.Add   ' , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 4) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(3).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(3).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 5) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(4).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(4).ReportIcon = 2
       End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 6) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(5).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(5).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 7) = "YES" Then
           ListView2.ListItems(i - 1).ListSubItems(6).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(6).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 8) = "YES" Then
         ListView2.ListItems(i - 1).ListSubItems(7).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(7).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 9) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(8).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(8).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 10) = "YES" Then
           ListView2.ListItems(i - 1).ListSubItems(9).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(9).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 11) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(10).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(10).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 12) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(11).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(11).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 13) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(12).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(12).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 14) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(13).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(13).ReportIcon = 2
        End If
        
        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 15) = "YES" Then

            ListView2.ListItems(i - 1).ListSubItems(14).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(14).ReportIcon = 2
        End If
    Next
    
    'Fill Users
    mysheet = "Users"
    lr = FindLastrow("Users")
    For i = 2 To lr
        Set objItem = ListView3.ListItems.Add(, , ThisWorkbook.Sheets(mysheet).Cells(i, 1))
    Next


End Function


'*********************************
'Modules code
Public Const cHideAll = 1
Public Const cSeleContainer = 2
Public Const cShowProgress = 3
Public Const cSeleUser = 4
Public Const cLogin = 5
Public Const cProcess = 6

Sub EntryPoint()
    Dim aObjName As Variant
    Dim aText As Variant
    Dim i As Long
'Load the form
    Load UserForm1

'for helping in documenting when I have created on the fly. Final version would not have this
    For Each ctl In UserForm1.Controls
        Debug.Print ctl.Name & " , " & TypeName(ctl)
    Next ctl
    
    ' Hide all form components that should be hidden
    'We do this before showing the form
    whichform cHideAll
    
    'Show the form
    UserForm1.Show
    
    'for helping in documenting when I have created on the fly. Final version would not have this
    For i = 1 To UserForm1.ListView2.ColumnHeaders.Count

        Debug.Print UserForm1.ListView2.ColumnHeaders(i).Width

    Next

End Sub

Function FindLastrow(myWorksheet As String) As Long
    Dim MyUsedRange As String
    Dim nUsedRows As Integer
    Dim lastRow As Long
    With ThisWorkbook.Sheets(myWorksheet).UsedRange
        MyUsedRange = .Address
        nUsedRows = .Rows.Count
        lastRow = .Rows(nUsedRows).Row
    End With
    FindLastrow = lastRow
End Function


Sub whichform(thisForm As Integer)
    CurrForm = thisForm
    'hide all control and elements on Userform1
    UserForm1.cb_process_BACC.Visible = False
    UserForm1.cb_process_bts.Visible = False
    UserForm1.cb_process_CSG.Visible = False
    UserForm1.cb_process_EAS.Visible = False
    UserForm1.cb_process_FRSNCA03PS0.Visible = False
    UserForm1.cb_process_FTFRCAAMPS0.Visible = False
    UserForm1.cb_process_HYWRCAZRPS0.Visible = False
    UserForm1.cb_process_RTPKCABTPS0.Visible = False
    UserForm1.cb_process_SNFGCAHBPS0.Visible = False
    UserForm1.cb_process_SNJSCABAPS0.Visible = False
    UserForm1.cb_process_Tracker.Visible = False
    UserForm1.CheckBox1.Visible = False
    UserForm1.CheckBox2.Visible = False
    UserForm1.CheckBox2.Visible = False
    'UserForm1.cmdClear.Visible = False
    'UserForm1.cmdFrame.Visible = False
    'UserForm1.cmdHideAll.Visible = False
    'UserForm1.cmdPause.Visible = False
    'UserForm1.cmdQuit.Visible = False
    'UserForm1.cmdResume.Visible = False
    ' UserForm1.cmdSeleContainer.Visible = False
    ' UserForm1.cmdSelect.Visible = False
    ' UserForm1.cmdSelectUser.Visible = False
    ' UserForm1.cmdShowProgress.Visible = False
    UserForm1.Label1.Visible = False
    UserForm1.Label2.Visible = False
    UserForm1.ListView1.Visible = False
    UserForm1.ListView2.Visible = False
    UserForm1.ListView3.Visible = False
    UserForm1.Password.Visible = False
    UserForm1.Username.Visible = False
    UserForm1.ListView1.Left = (1024 / 2) - (UserForm1.ListView1.Width / 2)

    'Selecting the mode that will show
    Select Case thisForm
    Case cHideAll ' Just shows the cmb buttons -keeping cmd buttons active for testing
        UserForm1.cmdHideAll.Visible = True
        UserForm1.cmdSeleContainer.Visible = True
        UserForm1.cmdShowProgress.Visible = True
        UserForm1.cmdSelectUser.Visible = True
        
    Case cSeleContainer ' this is used to select the first listview for container selection
        UserForm1.cmdHideAll.Visible = True
        UserForm1.cmdSeleContainer.Visible = True
        UserForm1.cmdShowProgress.Visible = True
        UserForm1.cmdSelectUser.Visible = True
        UserForm1.ListView1.Visible = True

    Case cShowProgress 'This activates ListView2 for the progress of items
        UserForm1.cmdHideAll.Visible = True
        UserForm1.cmdSeleContainer.Visible = True
        UserForm1.cmdShowProgress.Visible = True
        UserForm1.cmdSelectUser.Visible = True
        UserForm1.ListView2.Visible = True
        
    Case cSeleUser 'This activates ListView3 for the selection of User
        UserForm1.cmdHideAll.Visible = True
        UserForm1.cmdSeleContainer.Visible = True
        UserForm1.cmdShowProgress.Visible = True
        UserForm1.cmdSelectUser.Visible = True
        UserForm1.ListView3.Visible = True
        
    Case cLogin 'This activates the login screen
        UserForm1.cmdLogin.Visible = True
        UserForm1.Label1.Visible = True
        UserForm1.Label2.Visible = True
        UserForm1.Password.Visible = True
        UserForm1.Username.Visible = True
        
    Case cProcess 'This will show the process selections to be performed
        UserForm1.cb_process_BACC.Visible = True
        UserForm1.cb_process_bts.Visible = True
        UserForm1.cb_process_CSG.Visible = True
        UserForm1.cb_process_EAS.Visible = True
        UserForm1.cb_process_FRSNCA03PS0.Visible = True
        UserForm1.cb_process_FTFRCAAMPS0.Visible = True
        UserForm1.cb_process_HYWRCAZRPS0.Visible = True
        UserForm1.cb_process_RTPKCABTPS0.Visible = True
        UserForm1.cb_process_SNFGCAHBPS0.Visible = True
        UserForm1.cb_process_SNJSCABAPS0.Visible = True
        UserForm1.cb_process_Tracker.Visible = True


    End Select


End Sub

Make sure the module name is
'mLVSort.  Set this in
'your properties window

Option Explicit
Public objFind As LV_FINDINFO
Public objItem As LV_ITEM

'variable to hold the sort order (ascending or descending)
Public sOrder As Boolean
'variable to hold sort column
Public sColumn As Long

Public Type POINT
    x As Long
    y As Long
End Type

Public Type LV_FINDINFO
    flags As Long
    psz As String
    lParam As Long
    pt As POINT
    vkDirection As Long
End Type

Public Type LV_ITEM
    mask As Long
    iItem As Long
    iSubItem As Long
    state As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type

'Constants
Public Const LVFI_PARAM = 1
Public Const LVIF_TEXT = &H1

Public Const LVM_FIRST = &H1000
Public Const LVM_FINDITEM = LVM_FIRST + 13
Public Const LVM_GETITEMTEXT = LVM_FIRST + 45
Public Const LVM_SORTITEMS = LVM_FIRST + 48

'API declarations
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" ( _
                                        ByVal hWnd As Long, _
                                        ByVal wMsg As Long, _
                                        ByVal wParam As Long, _
                                        ByVal lParam As Long) As Long

Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" ( _
                                       ByVal hWnd As Long, _
                                       ByVal wMsg As Long, _
                                       ByVal wParam As Long, _
                                       lParam As Any) As Long
Public Function CompareDates(ByVal lParam1 As Long, _
                             ByVal lParam2 As Long, _
                             ByVal hWnd As Long) As Long

'CompareDates: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for date values.

'Compare returns:
' 0 = Less Than
' 1 = Equal
' 2 = Greater Than

    Dim dDate1 As Date, dDate2 As Date, dE As Boolean, d2E As Boolean
    On Error GoTo CDERR

    'Obtain the item names and dates corresponding to the
    'input parameters
    dDate1 = ListView_GetItemDate(hWnd, lParam1)
    dDate2 = ListView_GetItemDate(hWnd, lParam2)

    'based on the Public variable sOrder set in the
    'columnheader click sub, sort the dates appropriately:
    Select Case sOrder
    Case True:    'sort descending

        If dDate1 < dDate2 Then
            CompareDates = 0
        ElseIf dDate1 = dDate2 Then
            CompareDates = 1
        Else
            CompareDates = 2
        End If

    Case Else:    'sort ascending

        If dDate1 > dDate2 Then
            CompareDates = 0
        ElseIf dDate1 = dDate2 Then
            CompareDates = 1
        Else
            CompareDates = 2
        End If

    End Select
    Exit Function
CDERR:
    CompareDates = 1
End Function


Public Function CompareValues(ByVal lParam1 As Long, _
                              ByVal lParam2 As Long, _
                              ByVal hWnd As Long) As Long

'CompareValues: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for numeric values.

'Compare returns:
' 0 = Less Than
' 1 = Equal
' 2 = Greater Than

    Dim val1 As Long, val2 As Long
    On Error GoTo CDERR
    'Obtain the item names and values corresponding
    'to the input parameters
    val1 = ListView_GetItemValueStr(hWnd, lParam1)
    val2 = ListView_GetItemValueStr(hWnd, lParam2)

    'based on the Public variable sOrder set in the
    'columnheader click sub, sort the values appropriately:
    Select Case sOrder
    Case True:    'sort descending

        If val1 < val2 Then
            CompareValues = 0
        ElseIf val1 = val2 Then
            CompareValues = 1
        Else
            CompareValues = 2
        End If

    Case Else:    'sort ascending

        If val1 > val2 Then
            CompareValues = 0
        ElseIf val1 = val2 Then
            CompareValues = 1
        Else
            CompareValues = 2
        End If

    End Select
    Exit Function
CDERR:
    CompareValues = 1
End Function

Public Function CompareCurrency(ByVal lParam1 As Long, _
                                ByVal lParam2 As Long, _
                                ByVal hWnd As Long) As Long

'CompareValues: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for numeric values.

'Compare returns:
' 0 = Less Than
' 1 = Equal
' 2 = Greater Than

    Dim val1 As Currency, val2 As Currency
    On Error GoTo CDERR
    'Obtain the item names and values corresponding
    'to the input parameters
    val1 = ListView_GetItemCurrency(hWnd, lParam1)
    val2 = ListView_GetItemCurrency(hWnd, lParam2)

    'based on the Public variable sOrder set in the
    'columnheader click sub, sort the values appropriately:
    Select Case sOrder
    Case True:    'sort descending

        If val1 < val2 Then
            CompareCurrency = 0
        ElseIf val1 = val2 Then
            CompareCurrency = 1
        Else
            CompareCurrency = 2
        End If

    Case Else:    'sort ascending

        If val1 > val2 Then
            CompareCurrency = 0
        ElseIf val1 = val2 Then
            CompareCurrency = 1
        Else
            CompareCurrency = 2
        End If

    End Select
    Exit Function
CDERR:
    CompareCurrency = 1
End Function

Public Function ComparePercent(ByVal lParam1 As Long, _
                               ByVal lParam2 As Long, _
                               ByVal hWnd As Long) As Long

'CompareValues: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for numeric values.

'Compare returns:
' 0 = Less Than
' 1 = Equal
' 2 = Greater Than

    Dim val1 As Single, val2 As Single
    On Error GoTo CDERR
    'Obtain the item names and values corresponding
    'to the input parameters
    val1 = ListView_GetItemPercent(hWnd, lParam1)
    val2 = ListView_GetItemPercent(hWnd, lParam2)

    'based on the Public variable sOrder set in the
    'columnheader click sub, sort the values appropriately:
    Select Case sOrder
    Case True:    'sort descending

        If val1 < val2 Then
            ComparePercent = 0
        ElseIf val1 = val2 Then
            ComparePercent = 1
        Else
            ComparePercent = 2
        End If

    Case Else:    'sort ascending

        If val1 > val2 Then
            ComparePercent = 0
        ElseIf val1 = val2 Then
            ComparePercent = 1
        Else
            ComparePercent = 2
        End If

    End Select
    Exit Function
CDERR:
    ComparePercent = 1
End Function

Private Function ListView_GetItemDate(hWnd As Long, lParam As Long) As Date
    Dim r As Long, hIndex As Long
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)

    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)

    'get the string at subitem 1
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)

    'and convert it into a date and exit
    If r > 0 Then
        If IsDate(Left$(objItem.pszText, r)) Then
            ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
        Else
            ListView_GetItemDate = DateSerial(4501, 1, 1)
        End If
    End If
End Function


Public Function ListView_GetItemValueStr(hWnd As Long, lParam As Long) As Long
    Dim r As Long, hIndex As Long
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)

    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)

    'get the string at subitem 2
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)

    'and convert it into a long
    If r > 0 Then
        ListView_GetItemValueStr = CLng(Left$(objItem.pszText, r))
    End If
End Function

Public Function ListView_GetItemCurrency(hWnd As Long, lParam As Long) As Long
    Dim r As Long, hIndex As Long
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)

    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)

    'get the string at subitem 2
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)

    'and convert it into a long
    If r > 0 Then
        ListView_GetItemCurrency = CCur(Left$(objItem.pszText, r))
    End If
End Function

Public Function ListView_GetItemPercent(hWnd As Long, lParam As Long) As Long
    Dim r As Long, hIndex As Long, temp As String
    'Convert the input parameter to an index in the list view
    objFind.flags = LVFI_PARAM
    objFind.lParam = lParam
    hIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, objFind)

    'Obtain the value of the specified list view item.
    'The objItem.iSubItem member is set to the index
    'of the column that is being retrieved.
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = sColumn
    objItem.pszText = Space$(32)
    objItem.cchTextMax = Len(objItem.pszText)

    'get the string at subitem 2
    r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)

    'and convert it into a long
    If r > 0 Then
        temp = Left$(objItem.pszText, r)
        If Right$(temp, 1) = "%" Then
            temp = Left$(temp, Len(temp) - 1)
        End If
        ListView_GetItemPercent = CSng(temp)
    End If
End Function

Public Sub SortLvwOnDate(lvw As ListView, ColIndex As Long)
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareDates
End Sub

Public Sub SortLvwOnLong(lvw As ListView, ColIndex As Long)
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareValues
End Sub

Public Sub SortLvwOnCurrency(lvw As ListView, ColIndex As Long)
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareCurrency
End Sub

Public Sub SortLvwOnPercent(lvw As ListView, ColIndex As Long)
    lvw.Sorted = False
    If lvw.SortKey = ColIndex - 1 Then
        If lvw.SortOrder = lvwAscending Then
            lvw.SortOrder = lvwDescending
        Else
            lvw.SortOrder = lvwAscending
        End If
    Else
        lvw.SortKey = ColIndex - 1
        lvw.SortOrder = lvwAscending
    End If
    mLVSort.sColumn = ColIndex - 1
    mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
    SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf ComparePercent
End Sub

Open in new window

UserForm1.frm
UserForm1.frx
listviewSample.xlsm
0
 
LVL 34

Expert Comment

by:Norie
ID: 33591017
Those are the references I have - I'll try the file again later.

What version of Excel are you using? That might be more important than the OS you are using.
0
 

Author Comment

by:Bruj
ID: 33591366
I am using excel 2007 on both OSes
0
 
LVL 34

Expert Comment

by:Norie
ID: 33591525
I've managed to get something working.

Do you want me to attach it?

It's basically a stripped down version of yours, obviously with some of the functionality missing.

But it definitely shows the ListViews with the images.

Now that I've got it working I think I might have a bit of a play with it.:)
0
 

Author Comment

by:Bruj
ID: 33592554
Sure!
Here is a piece that should also help somebody a little more advanced then me (I understand it, just not sure how to get a few of the parms. It is written in VB, so... There are a few missing items

http://www.mjtnet.com/blog/2006/01/19/set-desktop-icon-positions/
Apparentaly, windows uses the same listview for arranging icons on the desktop!
0
 
LVL 34

Expert Comment

by:Norie
ID: 33592700
I'll attach it later - still not quite finished playing with it though.

I did find what appears to be a workaround for the alignment - just change the bitmaps.

With the ones you attached I just lengthened the whole image and then moved the symbol into the middle.

It seemed to work but I think each image might need to have the same dimensions - I got some pretty horrendous results
when I resized one and not the other.

I didn't try it but I thought it might be an idea to create left-aligned, centered and right-aligned bitmaps for each symbol.

Then add all the images to the list and write code that picks the one with the alignment you want to use.
0
 

Author Comment

by:Bruj
ID: 33592732
That could work if all columns are the same width (I may need to do it that way, there are just a few that are narrower, and uniform columns MAY look better, I am just trying to conserve screen space as with the production, the user will probably have 4 different apps going, and it would just make it easier for us to use.
0
 
LVL 34

Expert Comment

by:Norie
ID: 33592797
Well I can't see a limit on the no of images you can add to the list, so you could have a bitmap for all occasions.

By the way have you considered using a multipage with one page for each of the listviews.
0
 

Author Comment

by:Bruj
ID: 33593513
The showing of the listviews will actually be program driven. First it will let you select your user (by default, it will have your name selected, based on computer system name or system username, then it will close that screen, and pop the select container version, then it wil ask what you want to do with the container, then  finially it will process the containers, updating the progress listview, so I dont thing multipage would be quite right for this...
Thanks for the input!
0
 

Author Comment

by:Bruj
ID: 33605857
imnorie,


This what I came up with, I would think logically it SHOULD work(from what I could figure out. I am getting true on the sendmessage, so it SEEMS to work, but it does not...



Thanks
Bruce
Function fillListView(objItem As ListItem) As Long
    Dim lr As Long
    mysheet = "Sheet1 (2)"
    lr = FindLastrow("Sheet1 (2)")
    Dim t1 As Boolean
    Dim t2 As Boolean
    Dim tf As Long



    For i = 3 To lr
        If ThisWorkbook.Sheets(mysheet).Cells(i, 1) <> "" Then
            If ThisWorkbook.Sheets(mysheet).Cells(i, 7) = "" Then
                Set objItem = ListView1.ListItems.Add(, , ThisWorkbook.Sheets(mysheet).Cells(i, 1))
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 2)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 3)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 4)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 5)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 9)
                objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 11)


                ' If containers is needed ASAP, change to RED forecolor
                If UCase(ThisWorkbook.Sheets(mysheet).Cells(i, 11)) = UCase("yes") Then
                    ListView1.ListItems(ListView1.ListItems.Count).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).Bold = True
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(1).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(2).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(3).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(4).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(5).ForeColor = RGB(255, 0, 0)
                    ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Item(6).ForeColor = RGB(255, 0, 0)
                End If

            End If
        End If

    Next
    mysheet = "Sheet2"
    lr = FindLastrow("Sheet2")
    t = "BBa"
    numcnt = 1
    For i = 2 To lr
        Set objItem = ListView2.ListItems.Add(, , ThisWorkbook.Sheets(mysheet).Cells(i, 1))
        objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 2)
        objItem.ListSubItems.Add , , ThisWorkbook.Sheets(mysheet).Cells(i, 3)


        'Set subitems to icon, need to figure out how to center icon
        objItem.ListSubItems.Add   ' , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 4) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(3).ReportIcon = 1
            ListView2.ListItems(i - 1).ListSubItems(3).Text = t & numcnt


        Else
            ListView2.ListItems(i - 1).ListSubItems(3).ReportIcon = 2
            ListView2.ListItems(i - 1).ListSubItems(3).Text = t & numcnt
        End If


        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 5) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(4).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(4).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 6) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(5).ReportIcon = 1

        Else
            ListView2.ListItems(i - 1).ListSubItems(5).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 7) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(6).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(6).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 8) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(7).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(7).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 9) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(8).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(8).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 10) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(9).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(9).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 11) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(10).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(10).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 12) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(11).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(11).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 13) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(12).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(12).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 14) = "YES" Then
            ListView2.ListItems(i - 1).ListSubItems(13).ReportIcon = 1
        Else
            ListView2.ListItems(i - 1).ListSubItems(13).ReportIcon = 2
        End If

        objItem.ListSubItems.Add , , ""
        If ThisWorkbook.Sheets(mysheet).Cells(i, 15) = "YES" Then

            ListView2.ListItems(i - 1).ListSubItems(14).ReportIcon = 1
            '           Debug.Print ListView2.ListItems(i - 1).ListSubItems(14).hWnd

        Else
            ListView2.ListItems(i - 1).ListSubItems(14).ReportIcon = 2
            '  Debug.Print ListView2.ListItems(i - 1).ListSubItems(14).hWnd


        End If
        
        
        'test for moving icon
        numcnt = numcnt + 1
        Dim r1 As Variant
        Dim r2 As Point
        Dim r3 As Point

        t1 = SendMessageAny(ListView2.hWnd, Lvm_getitemposition, ListView2.ListItems(i - 1).ListSubItems(8).Index, r2)

        tf = MAKELPARAM(r2.x + 5000, r2.y + 2)
        t2 = SendMessageAny(ListView2.hWnd, Lvm_setitemposition, ListView2.ListItems(i - 1).ListSubItems(8).Index, tf)
        Dim u As Integer

      ' For u = 1 To 400 ' icon does not seem to move... is it a snap to grid issue?
        '    tf = MAKELPARAM(r2.x + u, r2.y + 2)
       ''     Debug.Print tf

         '   t1 = SendMessageAny(ListView2.hWnd, Lvm_getitemposition, ListView2.ListItems(i - 1).ListSubItems(8).Index, r3)
         '   t3 = SendMessageAny(ListView2.hWnd, Lvm_setitemposition, ListView2.ListItems(i - 1).ListSubItems(8).Index, tf)
         '   If r2.x <> r3.x Then
         '       Exit For
        '    End If
      ' Next
       



    Next

    'Fill Users
    mysheet = "Users"
    lr = FindLastrow("Users")
    For i = 2 To lr
        Set objItem = ListView3.ListItems.Add(, , ThisWorkbook.Sheets(mysheet).Cells(i, 1))
    Next


End Function

Open in new window

0
 
LVL 34

Accepted Solution

by:
Norie earned 500 total points
ID: 33606838
Bruce

What is the API actually meant to do?

Are you trying to use it to align the images?

Are you sure you can even access them individually, or the column they are in?

By the way I think you really should have a look at all the code you have - some of it just doesn't seem to be needed for what you want to do.

In fact some of it just makes it really hard to work out what's happening.

I'm sure it works and has it's uses but I think you could lose quite a lot of it.

Personally I would only keep the part that populated the listviews and perhaps some of the stuff for handling the buttons.

Even then a lot of what I would keep is only to get things actually working.

Once I had that then I would start looking into the possibility of aligning the icons.

I'll attach the trimmed down workbook I created from yours and maybe have a look at the code you are trying to use to move the icons.



EE---Bruj---02Sep2010---MyListVi.xls
0
 

Author Comment

by:Bruj
ID: 33612538
imnorie,

I have tried to submit a comment 3 times. Hope fully this one will work!

The APIs are supposed to center the icon
Here are some examples in C and vb
There are still a few things I need to figure out though
http://www.weask.us/entry/center-subitem-icon-listview
http://vbnet.mvps.org/index.html?code/comctl/lvitemindent.htm

Also, the attachment you sent does not have the bitmap. I was looking forward to seeing the puffin!
Thanks and good cheers! If you are in the US, happy Labor Day!
Bruce

0
 

Author Closing Comment

by:Bruj
ID: 33673149
Thabks for the assit, I am going with the modified images.
Again, thanks
0
 
LVL 34

Expert Comment

by:Norie
ID: 33673776
Bruce

Sorry about the puffin, kind of forgot it was on my local macine - wasn't it commented  out anyway?

By the way I just found a thread on another forum where the topic was about setting the back colour of the pages in a multipage.

One of the contributors (Jaafar Tribaak) came up with some API code that basically created a bitmap of the correct size and chosen colour for the page then used LoadPicture for the task.

I'm just wondering if it would be possible to have a set of 'base' images that could be resized for the column width/row height using some API.

Might avoid having a whole load of images kicking about,


I'll ask Jaafar later if it sounds viable, and/or it would be worth doing.
0
 

Author Comment

by:Bruj
ID: 33674114
I am also still looking into manipulating the FONT. I have seen that that is possible, but it may not be avalible in report view (and the threads that I was looking at for centering the icons, those were for ICON and SMALLICON view, that is why they were not working:(
As far as using multi sized icons, what I have settled for is using 3 column widths, so it is not to bad. Now I am needing to migrate my whole program to ACCESS (needing shared access, but it is easier for me to develope in Excel, debug and then convert to access - as I dont know access as well, learning though!)

Thanks again!
0
 
LVL 34

Expert Comment

by:Norie
ID: 33674404
Bruce

That is not an approach I would recommend, developing in Excel and converting to Access.

Why not just do everything in Access?

What part of what you want to do is actually Excel specific?

As far as I can see you are only really using it to store the data.

Now wouldn't a better place to store data be something crazy like a, um, database?

You would probably need to change the methods of using/accessing the data, eg for populating the listview, but the actual listview stuff won't change much.

The main reason for that is because the listview control isn't standard in either application.
0

Featured Post

NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
Ever wonder what it's like to get hit by ransomware? "Tom" gives you all the dirty details first-hand – and conveys the hard lessons his company learned in the aftermath.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…

801 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question