Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Populating listview Excel 2003

Status
Not open for further replies.

kalle82

Technical User
Apr 2, 2009
163
SE
Hi! The IT-department at my job decided to drop some controls and have not licensed a few others.

OUR SYSTEM
EXCEL 2003
IM NOT ALLOWED TO RUN ANYTHING AS ADMINISTRATOR

What this mean is:
I can no loner use the following controls
Microsoft Listview Control 6.0 (SP4) - Not avaiable any more
Microsoft Listview Control, version 5.0(SP2) - Not licensed

Thats really bad... But i Thought I found the solution with the following Control: "List View" (FPDTC.DLL). have never used that one and it seems it does not react the same like the ordinary listview controls I used before...

It just ends up telling me the Object does not support that...

So my question is IS THERE AN ALTERNATIVE APPROACH?

Code:
Private Sub readlist1()

    Dim ws As Worksheet
    Dim lngRow As Long
    Dim lvwItem As ListItem
    Dim lngEndCol As Long
    Dim lngCol As Long
    Dim lngEndRow As Long
    Dim lngItemIndex As Long
    Dim lvwItem2 As ListItem
    
    ' Sätter det som ska läsas in
        
    Set ws = Worksheets("Ärenden")
       
    lngEndCol = ws.Range("A1:Q1").End(xlToRight).Column
    lngEndRow = ws.Range("A1:Q1").End(xlDown).Row
    
    lngRow = 1
    With ListView1
        '.View = lvwReport
        For lngCol = 1 To lngEndCol
                                
        If lngCol <= 2 Or lngCol = 15 Then

' here's when it starts to go wrong.. 
            .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value
        
        ElseIf lngCol = 16 Then
        
        .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value
        
        ElseIf lngCol = 17 Then
        
        .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value, 180
        
        ElseIf lngCol >= 3 Or lngCol <= 14 Then
        
             .ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value, 0
        End If
        
        Next
        
        For lngRow = 2 To lngEndRow
            lngCol = 1
            lngItemIndex = 0
                                    
            Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, lngCol).Value)
            Dim n As Integer
           n = n + 1
           
            
            For lngCol = 2 To lngEndCol
                lngItemIndex = lngItemIndex + 1
           
                
                If lvwItem.SubItems(6) = "" Then
                
                
                Else
                
                               
                ListView1.ListItems.Remove (n)
                
                lngCol = 17
                n = n - 1
                
                GoTo sture

                End If
              
                svarsdatum1 = Worksheets("Ärenden").Cells(lngRow, 15)
                
                If svarsdatum1 = "" Then
                
                Else
                
                datum1 = DateValue(Format(svarsdatum1, "yyyy-mm-dd"))
                
                datum2 = DateValue(Format(Now(), "yyyy-mm-dd"))
                Dim datumskillnad As Integer
                
                
                datumskillnad = DateDiff("d", datum1, Now())
                
                'MsgBox "Svarsdatum är " & datum1 & " dagens datum är " & datum2 & " skillnaden är " & datumskillnad
                
                End If
             
                
                If lvwItem.SubItems(14) = "" Then
                
                
                Else
                
                Select Case datumskillnad
                
                Case Is = -1
                
                lvwItem.ForeColor = RGB(255, 165, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 14).ForeColor = RGB(255, 165, 0)
                    
                Case Is = -2
                
                lvwItem.ForeColor = RGB(255, 165, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 14).ForeColor = RGB(255, 165, 0)
                
                Case Is = -3
                
                lvwItem.ForeColor = RGB(255, 165, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 14).ForeColor = RGB(255, 165, 0)
                
                
                Case Is >= 0
                
                lvwItem.ForeColor = RGB(255, 0, 0)
                lvwItem.ListSubItems.Item(lngItemIndex - 14).ForeColor = RGB(255, 0, 0)
                
                Case Is <= -4
                
                lvwItem.ForeColor = RGB(100, 200, 50)
                lvwItem.ListSubItems.Item(lngItemIndex - 14).ForeColor = RGB(100, 200, 50)
                
                Case Else
                    
                    
                End Select
                
                
                
                
                
            
                End If
               ' Set lvwItem2 = .ListItems.Remove(lngItemIndex)
                
                
               ' .ListItem.Remove(lngItemIndex).Value
                
                lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value
                       
               
sture:
                
                'End If
           
            
            Next
       
        Next
        
    End With

End Sub



Hope anyone can help me to a solution on this matter ;)

Thanks you


 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top