ListView Sütun Aralıklarını Ayarlama Code Revizesi

[Believing]

Sayın Uzman Arkadaşlar,

Aşağıdaki kodlar ile ListView1 deki bütün sütun aralıkları aynı büyüklükte (80) ayarlanmıştır. Bu kodlarda nasıl bir değişiklik yaparak her sütunu farklı ölçeklerde ayarlayabilirim.

Saygılarımla,

Sub listele()
On Error Resume Next
ListView1.ColumnHeaders.Clear
ListView1.ListItems.Clear
With ListView1.ColumnHeaders
For i = 1 To 14
.Add , , Cells(1, i), 80, 0
Next i
End With
Dim r As Integer
For r = 2 To [a65536].End(3).Row
    Set liste = ListView1.ListItems.Add(, , Cells(r, 1).Value)
    For t = 1 To 13
        Select Case t
        Case 4, 5, 6, 10, 11
            liste.SubItems(t) = Format(Cells(r, t + 1).Value, "dd.mm.yyyy")
        Case 12
            liste.SubItems(t) = Format(Cells(r, t + 1).Value, "0.00%")
        Case Else
            liste.SubItems(t) = Cells(r, t + 1).Value
        End Select
    Next t
Next r
Me.ListView1.FullRowSelect = True
End Sub

Kodlar değerli bir arkadaştan alıntıdır.

 

[Korhan Ayhan]

İlgili bölümde döngü kullanılmış. Doğal olarak tüm sütunlar 80 punto olarak ayarlanıyor. Döngüyü kaldırırsanız istediğiniz sütun genişliklerini verebilirsiniz.

Döngülü bölüm;

With ListView1.ColumnHeaders
For i = 1 To 14
.Add , , Cells(1, i), 80, 0
Next i
End With

Olması gereken;

With ListView1.ColumnHeaders
.Add , , Cells(1, 1), 80, 0
.Add , , Cells(1, 2), 100, 0
.Add , , Cells(1, 3), 90, 0
.Add , , Cells(1, 4), 110, 0
.Add , , Cells(1, 5), 60, 0
.Add , , Cells(1, 6), 40, 0
.Add , , Cells(1, 7), 50, 0
.Add , , Cells(1, 8), 76, 0
.Add , , Cells(1, 9), 82, 0
.Add , , Cells(1, 10), 84, 0
.Add , , Cells(1, 11), 86, 0
.Add , , Cells(1, 12), 88, 0
.Add , , Cells(1, 13), 90, 0
.Add , , Cells(1, 14), 92, 0
End With

 

[Believing]

Sayın Korhan Ayhan,

Konuya gösterdiğiniz ilgi ve açıklamanız için size çok teşekkür ederim.
Mübarek RAMAZAN bayramınızı kutlar, sizin, aileniz ve tüm sevdikleriniz için hayırlara vesile olmasını dilerim.

Saygılarımla,