Excel Userform Da Listbox Nesnesi Alanlarının Biçimlendirmesi Hakkında.

Sadece formları sıfırdan oluşturmayı denediniz mi?
Ben de geç eklediğini fark ettim, normalde bu kadar ağır olmaması gerek, belki formlar bozulmustur.

(18/02/2021, 10:27)berduş yazdı: Sadece formları sıfırdan oluşturmayı denediniz mi?
Ben de geç eklediğini fark ettim, normalde bu kadar ağır olmaması gerek, belki formlar bozulmustur.

İnanın hepsini defalarca tek tek yaptım sayısını unuttum artık komple sildim tekrar hem formları hem kodları yeniden yazdım, yok olmuyor kağnı gibi çalışıyor.

Kayıt ekledeki else ile end if arasını alttaki gibi değiştirip deneyiniz.
Max functionu ile yaptım sadece id kısmını.Birde sıralatma kodu ekledim.

    Else

            Worksheets("Ana Sayfa").Cells(SonSatir, 1) = WorksheetFunction.Max(Worksheets("Ana Sayfa").Range("A2:A" & Rows.Count)) + 1

            Worksheets("Ana Sayfa").Cells(SonSatir, 2) = txt_MasrafTarihi.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 3) = Com_Firma.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 4) = txt_BelgeNo.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 5) = Com_MasrafTuru.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 6) = txt_Acýklama.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 7) = CDbl(txt_Tutar)

            Worksheets("Ana Sayfa").Range("A2").Sort Worksheets("Ana Sayfa").Range("A2"), xlDescending, , , , , , xlNo

    End If

Yada alttaki gibi kodu değiştirebilirsiniz.
Kayıt ekleme çalışınca il satırn altına satır eklenir ve herzaman 3.satırdaki verinin bir fazlası gelir İd olarak.
Kısaca Herzaman 2.satıra eklenir.Bunu uygularsanız ilk önce büyükten küçüğe sıralamanız gerekecek.

Private Sub btn_KayitEkle_Click()

If txt_MasrafTarihi <> "" And Com_Firma <> "" And txt_BelgeNo <> "" And Com_MasrafTuru <> "" And txt_Tutar <> "" Then

    Worksheets("Ana Sayfa").Range("A2").ListObject.ListRows.Add (1)

    Worksheets("Ana Sayfa").Range("A3:H3").Copy 'ilk satirin rengini almamasi icin eklendi

    Worksheets("Ana Sayfa").Range("A2:H2").PasteSpecial Paste:=xlPasteFormats 'ilk satirin rengini almamasi icin eklendi

    Application.CutCopyMode = False

    Worksheets("Ana Sayfa").Cells(2, 1) = Worksheets("Ana Sayfa").Cells(3, 1).Value + 1

    Worksheets("Ana Sayfa").Cells(2, 2) = txt_MasrafTarihi.Value

    Worksheets("Ana Sayfa").Cells(2, 3) = Com_Firma.Value

    Worksheets("Ana Sayfa").Cells(2, 4) = txt_BelgeNo.Value

    Worksheets("Ana Sayfa").Cells(2, 5) = Com_MasrafTuru.Value

    Worksheets("Ana Sayfa").Cells(2, 6) = txt_Acýklama.Value

    Worksheets("Ana Sayfa").Cells(2, 7) = CDbl(txt_Tutar)

Else

    MsgBox "Giriþ Alanlarýnýn Tümünü Doldurunuz", , "Masraf Giriþ Formu"

End If

Com_Firma.Value = ""

Com_MasrafTuru.Value = ""

txt_Acýklama.Value = ""

txt_BelgeNo.Value = ""

txt_MasrafTarihi.Value = ""

txt_Tutar.Value = ""

txt_MasrafTarihi = Format(Date, "dd.mm.yyyy")

Com_Firma.SetFocus

End Sub

(18/02/2021, 18:53)feraz yazdı: Kayıt ekledeki else ile end if arasını alttaki gibi değiştirip deneyiniz.
Max functionu ile yaptım sadece id kısmını.Birde sıralatma kodu ekledim.

    Else

            Worksheets("Ana Sayfa").Cells(SonSatir, 1) = WorksheetFunction.Max(Worksheets("Ana Sayfa").Range("A2:A" & Rows.Count)) + 1

            Worksheets("Ana Sayfa").Cells(SonSatir, 2) = txt_MasrafTarihi.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 3) = Com_Firma.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 4) = txt_BelgeNo.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 5) = Com_MasrafTuru.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 6) = txt_Acýklama.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 7) = CDbl(txt_Tutar)

            Worksheets("Ana Sayfa").Range("A2").Sort Worksheets("Ana Sayfa").Range("A2"), xlDescending, , , , , , xlNo

    End If

Sn. Feraz hocam ne kadar teşekkür etsem azdır. Bu kod sayesinde girişi yapılan kaydın kontrolü çok kolaylaştı. Allah ne muradınız varsa versin. List boxda sadece Tutar alanında yazan sayısal değerleri sağa yanaştırmanın, dayamanın bir yolu var mıdır. Yoksa da canınız sağolsun. Çok teşekkürler.

(20/02/2021, 14:45)Oğuz Türkyılmaz yazdı:

(18/02/2021, 18:53)feraz yazdı: Kayıt ekledeki else ile end if arasını alttaki gibi değiştirip deneyiniz.
Max functionu ile yaptım sadece id kısmını.Birde sıralatma kodu ekledim.

    Else

            Worksheets("Ana Sayfa").Cells(SonSatir, 1) = WorksheetFunction.Max(Worksheets("Ana Sayfa").Range("A2:A" & Rows.Count)) + 1

            Worksheets("Ana Sayfa").Cells(SonSatir, 2) = txt_MasrafTarihi.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 3) = Com_Firma.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 4) = txt_BelgeNo.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 5) = Com_MasrafTuru.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 6) = txt_Acýklama.Value

            Worksheets("Ana Sayfa").Cells(SonSatir, 7) = CDbl(txt_Tutar)

            Worksheets("Ana Sayfa").Range("A2").Sort Worksheets("Ana Sayfa").Range("A2"), xlDescending, , , , , , xlNo

    End If

Sn. Feraz hocam ne kadar teşekkür etsem azdır. Bu kod sayesinde girişi yapılan kaydın kontrolü çok kolaylaştı. Allah ne muradınız varsa versin. List boxda sadece Tutar alanında yazan sayısal değerleri sağa yanaştırmanın, dayamanın bir yolu var mıdır. Yoksa da canınız sağolsun. Çok teşekkürler.

Rica ederim.Sizdende Allah razı olsun.
Tam olarak emin değilim yinede yazayım eğer Tutar sütunundaki veriler sağa yaslı ise Rowsource ile alınırsa Listboxttada sağa yaslı gelir biliyorum.Emin değilim yinede.