Çözüldü Listboxtan sayfaya kaydetmede sayı yerine metin kaydetme hatası

[FERAZ]

Merhaba.
Sayın AYHAN'ın verdiği koddaki Space:=False gibi değeri False olanları silerek deneyin isterseniz.
.

Merhaba hocam sağolun.

 

[Korhan Ayhan]

Merhaba,

14 nolu mesajımdaki kodu daha büyük sayılarda denerken olumsuz sonuçlar aldım. Bu sebeple aşağıdaki kodu kullanmanızı öneriyorum.

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    
    son = Cells(Rows.Count, 1).End(3).Row
    
    With Me.ListBox1
        If .ListCount > 0 Then
            If MsgBox("Kaydedilsin mi?", vbQuestion + vbYesNo, "Kaydetme") = vbYes Then
                Range("B:B").HorizontalAlignment = xlRight
                Range("B:B").NumberFormat = "@"
                Range("A" & son + 1).Resize(.ListCount, 2).Value = .List
                Range("A:B").EntireColumn.AutoFit
                son = Cells(Rows.Count, 2).End(3).Row
                For Each Veri In Range("B2:B" & son)
                    Veri.Value = CDbl(Veri.Value)
                Next
                Range("B:B").NumberFormat = "0.00"
                MsgBox "Kaydedildi...", vbInformation, "Kaydetme"
                .Clear
                Exit Sub
            Else
                MsgBox "Kaydetme iptal edildi...", vbExclamation, "Kaydetme"
                Exit Sub
            End If
        Else
            MsgBox "Listbox Bos Olamaz...", vbExclamation, "Kaydetme"
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click()
    With Me.ListBox1
       .AddItem Me.TextBox1.Text
       .List(.ListCount - 1, 1) = Me.TextBox2.Value
    End With
End Sub

 

[FERAZ]

Korhan hocam listboxtan topluca kaydetme amacım Giftede görüldüğü gibi sayfa kodu olaylarında gereksiz çalışmamasıydı.
Enableevents=false ve true ekleyince kod gereksiz çalışmıyır lakin Enableevents kodları hata durumunda tüm kodları durduruyor genel olarak.
Birde testlerim sonucu listboxtan list olarak topluca kaydedince ADO ile veri alırken veriler çıkmıyor mesela başka bir listboxaveri çekersem ADO ile.
Örnek dosya eklersem ya buraya yada ayrı bir konu açabilirim.

 

[Korhan Ayhan]

Zafer Bey,

Hata kontrollerini kullanarak bu tarz durumlara önlem alınabilir. Şimdi bu kod sağlıksız olsaydı zaten bizlerin kullanımına sunulmazdı. Bu sebeple kullanmaktan çekinmeyin.

Diğer sorunuz için ayrı başlık açabilirsiniz.

 

[FERAZ]

Zafer Bey,

Hata kontrollerini kullanarak bu tarz durumlara önlem alınabilir. Şimdi bu kod sağlıksız olsaydı zaten bizlerin kullanımına sunulmazdı. Bu sebeple kullanmaktan çekinmeyin.

Diğer sorunuz için ayrı başlık açabilirsiniz.

Tamam korhan hocam ben araştıracağım yabancı forumları felan bir kısa çözümü varmıdır diye.Aklıma gelen bir yöntemide dgneyeceğim listbox.list verilerini dizi içine alıp orda formatlayıp hücreye toplu yollayacağım.Eğer istediğim gibi olursa paylaşırım burda.

 

[FERAZ]

Kodları alttaki gibi dizi içine alarak sorun giderilmiştir.
Artık metin olarak algılanmıyor sayılar
Ve Ado olayıda çözüldü bu sayede.
Cevap yazan herkese teşekkürler.

Private Sub CommandButton1_Click()
    Dim arr(), i As Integer
    Application.ScreenUpdating = False
    son = Cells(Rows.Count, 1).End(3).Row
    If son = 1 Then son = 2
    With Me.ListBox1
        ReDim arr(1 To .ListCount, 1 To 2)
       
        For i = 1 To .ListCount
            arr(i, 1) = .List(i - 1)
            arr(i, 2) = CDbl(.List(i - 1, 1))
        Next
        son = Cells(Rows.Count, 1).End(3).Row
        Range("A" & son + 1).Resize(.ListCount, 2).Value = arr
    End With
    Application.ScreenUpdating = True
    Erase arr
End Sub

 

[Korhan Ayhan]

Tebrikler...

 

[FERAZ]

Tebrikler...

Sağolun garip olan listboxtan direkt yollarken olmuyor dizi içinden yollarken oluyor.
Ado ile olmamasının nedenide Cdate(.List(i - 1, 1)) gibi formatlayınca çözüldü.
Aslında hiç döngü ve gerek olmadan çözülür sanmıştım fakat önemli değil dizi kasmıyor hiç.
Orjinal dosyamdaki kodda alttaki gibi oluştu.

Private Sub CommandButton1_Click() 'Sayfaya Kaydet
  
  Dim arr(), i As Integer
  
    basldmGder = True
    Application.ScreenUpdating = False
  
    son = SayfaAddd.Cells(Rows.Count, 2).End(3).Row
     If son < 8 Then son = 8
    
    With Me.ListBox1
        If .ListCount > 0 Then
            If MsgBox("Kaydedilsin mi?", vbQuestion + vbYesNo, "Kaydetme") = vbYes Then
                Me.Hide
                
                ReDim arr(1 To .ListCount, 1 To 9)
                For i = 1 To .ListCount
                    arr(i, 1) = .List(i - 1)
                    arr(i, 2) = CDate(.List(i - 1, 1))
                    arr(i, 3) = .List(i - 1, 2)
                    arr(i, 4) = .List(i - 1, 3)
                    arr(i, 5) = .List(i - 1, 4)
                    arr(i, 6) = .List(i - 1, 5)
                    arr(i, 7) = .List(i - 1, 6)
                    arr(i, 8) = .List(i - 1, 7)
                    arr(i, 9) = CDbl(.List(i - 1, 8))
                Next
                son = SayfaAddd.Cells(Rows.Count, 2).End(3).Row
                SayfaAddd.Range("A" & son + 1).Resize(.ListCount, 9).Value = arr
              Call renklendir_Gider
                MsgBox "Kaydedildi...", vbInformation, "Kaydetme"
                
                        Me.CommandButton2.Enabled = False
                        Me.CommandButton3.Enabled = False
                
                .Clear
                basldmGder = False
                Me.Show
                Exit Sub
            Else
                MsgBox "Kaydetme iptal edildi...", vbExclamation, "Kaydetme"
                 basldmGder = False
                Exit Sub
            End If
        Else
            MsgBox "Listbox Bos Olamaz...", vbExclamation, "Kaydetme"
             basldmGder = False
            Exit Sub
        End If
    End With
  
   basldmGder = False
  
    Application.ScreenUpdating = True
    Erase arr
  
End Sub