[Resolvido]Ordernar ListView

Ola Boa tarde !
Alguma ideia de como Ordenar uma listview clicando no cabecalho ?

Obg!

As tabelas envolvidas na consulta não existem no banco de dados.
Poderia enviar novamente o banco de dados com as tabelas referentes à consulta?

Alguma ideia ou exemplo ?

olá amigo boa tarde.

Vou tentar ajudar. pois comigo funciona ...
Porem o listview que utilizp é em VBA Excel.

dentro do userfom declare ao iniciar....

Private Sub UserForm_Initialize()

'cabecalho do listview
With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add(Text:="Código", Width:=0, Alignment:=fmAlignmentLeft).Tag = "Number"
.ColumnHeaders.Add(Text:="Num.lote", Width:=80, Alignment:=fmAlignmentRight).Tag = "Number"
.ColumnHeaders.Add(Text:="Num.Tanque", Width:=80, Alignment:=fmAlignmentRight).Tag = "Number"
.ColumnHeaders.Add(Text:="Qtd no Tanque", Width:=80, Alignment:=fmAlignmentRight).Tag = "Number"
.ColumnHeaders.Add(Text:="Linha", Width:=60, Alignment:=fmAlignmentRight).Tag = "Number"
.ColumnHeaders.Add(Text:="Sequencial", Width:=60, Alignment:=fmAlignmentRight).Tag = "Number"


End With
end sub


observe que ao final de cada linha é declarado o tipo de campo que estará na coluna que poderá ser
.Tag = "Number" Para números
.Tag = "Date" Para Datas
.Tag = "String" Para Textos.


agora basta colocar o código abaixo e quando clicar no cabeçalho do listview ... ele ordenará






' Classificando Colunas
Private Sub Listview1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'-------------------------------------------------------------------------

On Error Resume Next




' Começa ordenar o listview pela coluna clicada

With ListView1

' Display the hourglass cursor whilst sorting

Dim lngCursor As Long
lngCursor = .MousePointer
.MousePointer = vbHourglass

' Prevent the ListView control from updating on screen -
' this is to hide the changes being made to the listitems
' and also to speed up the sort



' Check the data type of the column being sorted,
' and act accordingly

Dim l As Long
Dim strFormat As String
Dim strData() As String

Dim lngIndex As Long
lngIndex = ColumnHeader.Index - 1

Select Case UCase$(ColumnHeader.Tag)
Case "DATE"

' Sort by date.

strFormat = "YYYYMMDDHhNnSs"

' Loop through the values in this column. Re-format
' the dates so as they can be sorted alphabetically,
' having already stored their visible values in the
' tag, along with the tag's original value

With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .item(l).ListSubItems(lngIndex)
.Tag = .Text & Chr$(0) & .Tag
If IsDate(.Text) Then
.Text = Format(CDate(.Text), _
strFormat)
Else
.Text = ""
End If
End With
Next l
Else
For l = 1 To .Count
With .item(l)
.Tag = .Text & Chr$(0) & .Tag
If IsDate(.Text) Then
.Text = Format(CDate(.Text), _
strFormat)
Else
.Text = ""
End If
End With
Next l
End If
End With

' Sort the list alphabetically by this column

.SortOrder = (.SortOrder + 1) Mod 2
.SortKey = ColumnHeader.Index - 1
.Sorted = True

' Restore the previous values to the 'cells' in this
' column of the list from the tags, and also restore
' the tags to their original values

With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .item(l).ListSubItems(lngIndex)
strData = Split(.Tag, Chr$(0))
.Text = strData(0)
.Tag = strData(1)
End With
Next l
Else
For l = 1 To .Count
With .item(l)
strData = Split(.Tag, Chr$(0))
.Text = strData(0)
.Tag = strData(1)
End With
Next l
End If
End With

Case "NUMBER"

' Sort Numerically

strFormat = String(30, "0") & "." & String(30, "0")

' Loop through the values in this column. Re-format the values so as they
' can be sorted alphabetically, having already stored their visible
' values in the tag, along with the tag's original value

With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .item(l).ListSubItems(lngIndex)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), _
strFormat)
Else
.Text = "&" & InvNumber( _
Format(0 - CDbl(.Text), _
strFormat))
End If
Else
.Text = ""
End If
End With
Next l
Else
For l = 1 To .Count
With .item(l)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), _
strFormat)
Else
.Text = "&" & InvNumber( _
Format(0 - CDbl(.Text), _
strFormat))
End If
Else
.Text = ""
End If
End With
Next l
End If
End With

' Sort the list alphabetically by this column

.SortOrder = (.SortOrder + 1) Mod 2
.SortKey = ColumnHeader.Index - 1
.Sorted = True

' Restore the previous values to the 'cells' in this
' column of the list from the tags, and also restore
' the tags to their original values

With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .item(l).ListSubItems(lngIndex)
strData = Split(.Tag, Chr$(0))
.Text = strData(0)
.Tag = strData(1)
End With
Next l
Else
For l = 1 To .Count
With .item(l)
strData = Split(.Tag, Chr$(0))
.Text = strData(0)
.Tag = strData(1)
End With
Next l
End If
End With

Case Else ' Assume sort by string

' Sort alphabetically. This is the only sort provided
' by the MS ListView control (at this time), and as
' such we don't really need to do much here

.SortOrder = (.SortOrder + 1) Mod 2
.SortKey = ColumnHeader.Index - 1
.Sorted = True

End Select



.MousePointer = lngCursor

End With

End Sub

' Classificando Colunas
'****************************************************************
' InvNumber
' Function used to enable negative numbers to be sorted
' alphabetically by switching the characters
'----------------------------------------------------------------

Private Function InvNumber(ByVal Number As String) As String
Static i As Integer
For i = 1 To Len(Number)
Select Case Mid$(Number, i, 1)
Case "-": Mid$(Number, i, 1) = " "
Case "0": Mid$(Number, i, 1) = "9"
Case "1": Mid$(Number, i, 1) = "8"
Case "2": Mid$(Number, i, 1) = "7"
Case "3": Mid$(Number, i, 1) = "6"
Case "4": Mid$(Number, i, 1) = "5"
Case "5": Mid$(Number, i, 1) = "4"
Case "6": Mid$(Number, i, 1) = "3"
Case "7": Mid$(Number, i, 1) = "2"
Case "8": Mid$(Number, i, 1) = "1"
Case "9": Mid$(Number, i, 1) = "0"
End Select
Next
InvNumber = Number
End Function



se for isso , foi um prazer ajudá-lo.
Caso contrario tentei por ajudar.

Obg Pela Ajuda!


Esta dando erro na seguinte linha
lngIndex = ColumnHeader.Index - 1
Erro em tempo de execuçao '424'
Objeto é obrigatorio!

O que é esse lngIndex ?

Alguem ?

boa noite
nao sei responder amigo ...
pois esse código eu peguei na net também ... mas comigo funciona perfeitamente.

observacao ... todo o código postado anteriormente deve estar dentro do userform que carregar o listview ok.
meus cumprimentos.

Resolvi com esse código !

Private Sub LstView_LstView_Produtos_ColumnClick(ByVal ColumnHeader As Object)
On Error GoTo err_handle

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Variáveis
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim I As Integer
I = ColumnHeader.Index - 1

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Inicializa o controle de imagens (Este controle está no form e permite icones em BMP
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lvxObj.ColumnHeaderIcons = Nothing
lvxObj.ColumnHeaderIcons = Me.axImageList.Object

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Ativa classificação no cabeçalho da coluna
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lvxObj.Sorted = True
lvxObj.SortKey = I

'executar a classificação e atribuir os ícones
If lvxObj.SortOrder = lvwAscending Then
lvxObj.SortOrder = lvwDescending
ColumnHeader.Icon = "Sort_ZA" 'aplica o ícone ao cabeçalho da coluna
ElseIf lvxObj.SortOrder = lvwDescending Then
lvxObj.SortOrder = lvwAscending
ColumnHeader.Icon = "Sort_AZ" 'aplica o ícone ao cabeçalho da coluna
End If
'Atualiza
lvxObj.Refresh

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Tratamento de Erro
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
err_handle:
Select Case Err.Number
Case 0
'ignora, não e um erro
Case Else
MsgBox "Err: LstView_Produtos" & vbCrLf & Err.Description, vbCritical, Err.Number
End Select
End Sub