Solved

listVIEW question...

Posted on 2010-08-30
35
633 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
  • 15
  • 12
  • 6
35 Comments
 
LVL 45

Expert Comment

by:patrickab
ID: 33565673
Bruj,

Please upload your file.

Patrick
0
 
LVL 33

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
 
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 33

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 33

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 33

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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 33

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 33

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 33

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 33

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 33

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 33

Accepted Solution

by:
Norie earned 125 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 33

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 33

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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

705 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now