Listview

[osmanucel]

Arkadaslar demir bağlantı sayfam var
burda
alış baglantılarım vesatış bağlantılarım var
2 tane lıstwiew bırınde alış gözuksun dıgerınde satış ıstıyorum ama bı turlu beceremedım
lısteyıde bozdum bı bakabılırmısınız

 

[Ömer]

Merhaba,

Önce formu düzeltmek için yeni bir userform çizip üzerine bir listwiew ekleyin, daha sonra çalıştığınız formdaki eski kodları silip aşağıdaki kodları ilgili bölüme kopyalayın.

Formu çalıştırın, büyük ihtimalle istediğiniz olacaktır. Daha sonra eklediğiniz diğer userformu silersiniz.

Private Sub UserForm_Initialize()
 
    Dim Sb As Worksheet, i As Long, x As Long
    
    Set Sb = Sheets("BGS")
    Me.Caption = "BAĞLANTI LİSTESİ                "
  
    With ListView1
        .ListItems.Clear
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        .Font.Size = 9
    End With
    With ListView1.ColumnHeaders
        .Add , , "Sıra No", 0
        .Add , , Sb.Range("A1"), 30, lvwColumnCenter
        .Add , , Sb.Range("B1"), 170, lvwColumnLeft
        .Add , , Sb.Range("C1"), 60, lvwColumnCenter
        .Add , , Sb.Range("D1"), 60, lvwColumnCenter
        .Add , , Sb.Range("E1"), 50, lvwColumnRight
        .Add , , Sb.Range("F1"), 50, lvwColumnRight
        .Add , , Sb.Range("G1"), 50, lvwColumnRight
        .Add , , Sb.Range("H1"), 90, lvwColumnRight
        .Add , , Sb.Range("I1"), 90, lvwColumnRight
        .Add , , Sb.Range("J1"), 90, lvwColumnRight
        .Add , , Sb.Range("K1"), 90, lvwColumnRight
        .Add , , Sb.Range("L1"), 90, lvwColumnRight
        .Add , , Sb.Range("M1"), 90, lvwColumnRight
    End With
    
    On Error Resume Next
    With ListView1
        For i = 3 To Sb.[B65536].End(3).Row
            If Sb.Cells(i, "D") = "ALIŞ" Then
                x = x + 1
                .ListItems.Add , , i
                .ListItems(x).SubItems(1) = Sb.Cells(i, "A")
                .ListItems(x).SubItems(2) = Sb.Cells(i, "B")
                .ListItems(x).SubItems(3) = Sb.Cells(i, "C")
                .ListItems(x).SubItems(4) = Sb.Cells(i, "D")
                .ListItems(x).SubItems(5) = Format(Sb.Cells(i, "E"), "#,##0.000 TL")
                .ListItems(x).SubItems(6) = Format(Sb.Cells(i, "F"), "#,##0.000 TL")
                .ListItems(x).SubItems(7) = Format(Sb.Cells(i, "G"), "#,##0.000 TL")
                .ListItems(x).SubItems(8) = Format(Sb.Cells(i, "H"), "#,##0 KG")
                .ListItems(x).SubItems(9) = Format(Sb.Cells(i, "I"), "#,##0 KG")
                .ListItems(x).SubItems(10) = Format(Sb.Cells(i, "J"), "#,##0 KG")
                .ListItems(x).SubItems(11) = Format(Sb.Cells(i, "K"), "#,##0.00 TL")
                .ListItems(x).SubItems(12) = Format(Sb.Cells(i, "L"), "#,##0.00 TL")
                .ListItems(x).SubItems(13) = Format(Sb.Cells(i, "M"), "#,##0.00 TL")
            End If
        Next i
    End With
    
    
    With ListView2
        .ListItems.Clear
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        .Font.Size = 9
    End With
    With ListView2.ColumnHeaders
        .Add , , "Sıra No", 0
        .Add , , Sb.Range("A1"), 30, lvwColumnCenter
        .Add , , Sb.Range("B1"), 170, lvwColumnLeft
        .Add , , Sb.Range("C1"), 60, lvwColumnCenter
        .Add , , Sb.Range("D1"), 60, lvwColumnCenter
        .Add , , Sb.Range("E1"), 50, lvwColumnRight
        .Add , , Sb.Range("F1"), 50, lvwColumnRight
        .Add , , Sb.Range("G1"), 50, lvwColumnRight
        .Add , , Sb.Range("H1"), 90, lvwColumnRight
        .Add , , Sb.Range("I1"), 90, lvwColumnRight
        .Add , , Sb.Range("J1"), 90, lvwColumnRight
        .Add , , Sb.Range("K1"), 90, lvwColumnRight
        .Add , , Sb.Range("L1"), 90, lvwColumnRight
        .Add , , Sb.Range("M1"), 90, lvwColumnRight
    End With
    
    x = 0
    With ListView2
        For i = 3 To Sb.[B65536].End(3).Row
            If Sb.Cells(i, "D") = "SATIŞ" Then
                x = x + 1
                .ListItems.Add , , i
                .ListItems(x).SubItems(1) = Sb.Cells(i, "A")
                .ListItems(x).SubItems(2) = Sb.Cells(i, "B")
                .ListItems(x).SubItems(3) = Sb.Cells(i, "C")
                .ListItems(x).SubItems(4) = Sb.Cells(i, "D")
                .ListItems(x).SubItems(5) = Format(Sb.Cells(i, "E"), "#,##0.000 TL")
                .ListItems(x).SubItems(6) = Format(Sb.Cells(i, "F"), "#,##0.000 TL")
                .ListItems(x).SubItems(7) = Format(Sb.Cells(i, "G"), "#,##0.000 TL")
                .ListItems(x).SubItems(8) = Format(Sb.Cells(i, "H"), "#,##0 KG")
                .ListItems(x).SubItems(9) = Format(Sb.Cells(i, "I"), "#,##0 KG")
                .ListItems(x).SubItems(10) = Format(Sb.Cells(i, "J"), "#,##0 KG")
                .ListItems(x).SubItems(11) = Format(Sb.Cells(i, "K"), "#,##0.00 TL")
                .ListItems(x).SubItems(12) = Format(Sb.Cells(i, "L"), "#,##0.00 TL")
                .ListItems(x).SubItems(13) = Format(Sb.Cells(i, "M"), "#,##0.00 TL")
            End If
        Next i
    End With
    
 
End Sub

.

 

[osmanucel]

Hocam buyuk ıhtımalle degıl tam oturdu allah razı olsun

 

[osmanucel]

Hocam bıde buna el atsanız

Sayfada b2-c2-d2 hucrelerinden verı alıyorum tekboxlara
hocam kuruş olmadıgı zaman duzgun alıyo eger kuruslu ıse
kurusu görmuyo bı bakabılırmısınız

 

[Ömer]

Change kodlarını koymanıza gerek yok. 7-8-9 için koyduğunuz "TextBox_Change" kodlarını silin ve Initialize kodlarını aşağıdaki gibi değiştirin.

Private Sub UserForm_Initialize()
 
    Dim Sg As Worksheet
 
    Set Sg = Sheets("GBA")
 
    TextBox7 = Format(Sg.Range("B2"), "#,##0.00 TL")
    TextBox8 = Format(Sg.Range("C2"), "#,##0.00 TL")
    TextBox9 = Format(Sg.Range("B2"), "#,##0.00 TL")
      
End Sub

 

[osmanucel]

Hocam çok teşekkür ederim sagolun
biz hiç bişi bilmiyomuşuz ya
allah razı olsun

 

[Ömer]

Rica ederim Osman bey.

Deneyerek, çalışarak, araştırarak.... belirli süreçlerden sonra zamanla bilginizin arttığını gözlemlersiniz. Her an yeni birşeyler öğrenmeye devam ediyoruz.

 

[osmanucel]

Haklısınız sayenızde allah razı olsun