sütun genişliğini otomatik ayarlamak

[bitmez13]

ekli örnekte comboboxdaki sayfa seçimine göre listviewde sayfa görüntüleniyor.Benim isteğim listview sayfaları görüntülerken sayfadaki sütun genişliklerini otomatik algılayıp genişliği sayfaya göre ayarlasın sayfa 1 deki b sütün genişliği 222 pikselken iken sayfa 2deki b sutun genişliği 64 piksel listviewdede görüntüleme bu şekilde olabilirmi teşekkürler

 

[Korhan Ayhan]

Selamlar,

ComboBox1 ve ListBox1 kodlarını aşağıdaki şekilde değiştirip denermisiniz.
Eklenen kısımlar kırmızı renkle belirtilmiştir.

Private Sub comboBox1_Click()
Sheets(Me.ComboBox1.Text).Select
Me.Caption = ActiveSheet.Name
Dim arrVeri() As Variant
Dim sh As Worksheet, rng As Range, baslik As Range
Dim i%, j%, y%
Dim bas As Variant
Set sh = Sheets(ComboBox1.Text)
Set rng = sh.[A1].CurrentRegion
Set baslik = sh.Range(sh.Cells(1, 1), sh.Cells(1, sh.Cells(1, 255).End(1).Column))
ReDim arrVeri(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        arrVeri(i, j) = sh.Cells(i + 1, j)
    Next j
Next i
'------------------------------------------
'LISTBOX'a veri yükleme
'------------------------------------------

'------------------------------------------
'LISTVIEW'e veri yükleme
'------------------------------------------
With ListView1
   .ListItems.Clear
   .ColumnHeaders.Clear
   .View = lvwReport
   .Gridlines = True
   .FullRowSelect = True
    For Each bas In baslik
        .ColumnHeaders.Add , , bas.Text, [COLOR=red]bas.ColumnWidth * 5.5[/COLOR]
    Next
On Error Resume Next
    For i = 1 To rng.Rows.Count
        y = y + 1
        .ListItems.Add , , arrVeri(i, 1)
        For j = 1 To rng.Columns.Count
            .ListItems(y).SubItems(j) = arrVeri(i, j + 1)
        Next j
    Next i
End With
Set sh = Nothing
Set rng = Nothing
Set baslik = Nothing
End Sub

Private Sub ListBox1_Click()
Dim arrVeri() As Variant
Dim sh As Worksheet, rng As Range, baslik As Range
Dim i%, j%, y%
Dim bas As Variant
Set sh = Sheets(ListBox1.Text)
Set rng = sh.[A1].CurrentRegion
Set baslik = sh.Range(sh.Cells(1, 1), sh.Cells(1, sh.Cells(1, 255).End(1).Column))
ReDim arrVeri(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        arrVeri(i, j) = sh.Cells(i + 1, j)
    Next j
Next i
With ListView1
   .ListItems.Clear
   .ColumnHeaders.Clear
   .View = lvwReport
   .Gridlines = True
   .FullRowSelect = True
    For Each bas In baslik
        .ColumnHeaders.Add , , bas.Text, [COLOR=red]bas.ColumnWidth * 5.5[/COLOR]
    Next
On Error Resume Next
    For i = 1 To rng.Rows.Count
        y = y + 1
        .ListItems.Add , , arrVeri(i, 1)
        For j = 1 To rng.Columns.Count
            .ListItems(y).SubItems(j) = arrVeri(i, j + 1)
        Next j
    Next i
End With
Set sh = Nothing
Set rng = Nothing
Set baslik = Nothing
End Sub

 

[bitmez13]

teşekkür

çok teşekkürler sağolun varolun