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?
Hope anyone can help me to a solution on this matter![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
Thanks you
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