listview dan sayfaya aktarımda tl sorunu

[ulutanas]

Arkadaşlar form üzerinde text ve combobox ları listview a aktarıyorum 5-6 kayıt girip daha sonrasından son kontroller yapılınca sayfaya aktarıyorum buraya kadar sorun yok fakat sayfaya aktardıkdan sonra örnek (listview de 100.00.TL olan değerler) sayfada 100 olarak aktarılıyor ve aktarılan hücrede metin olarak saklanan sayı diye hata mesajı geliyor. Hücreyi çift tıklarsam sorun düzeliyor fakat her bir kaydı çift tıklarsam baya işimiz var demektir. Sanırım listview dan sayfaya aktarım kodun da bir hata var yazdığım kod aşağıdaki gibi bir sorun varmı inceleyebilirmisiniz size zahmet.
Konu hakkında yardımcı olan arkadaşlara şimdiden teşekkür ederim.
İyi çalışmlar.



Private Sub CommandButton3_Click()
yer = "KAYIT_DEFTERİ"
sat1 = Worksheets(yer).[a65536].End(3).Row + 1
For r = 1 To ListView1.ListItems.Count + 1
Sheets(yer).Cells(sat1, 1).Value = ListView1.ListItems(r)
On Error Resume Next
For i = 0 To ListView1.ColumnHeaders.Count - 1
Sheets(yer).Cells(sat1, i + 1).Value = ListView1.ListItems(r).ListSubItems(i).Text
Next i
sat1 = sat1 + 1
Next r

deger1 = 0
MsgBox "İŞLEM TAMAM", , "....."
End Sub

 

[Korhan Ayhan]

Merhaba,

Sayısal değer olan sütunları excele aktarırken biçimlendirmeniz gerekmektedir.

CDBL - Ondalıklı değerler için kullanılır.
CLNG - Uzun tamsayılar için kullanılır.
CDATE - Tarihler için kullanılır.


Aşağıdaki örnekte;

Eğer i değeri 5 ise ondalıklı biçim uygula diyoruz.

If i = 5 Then Sheets(yer).Cells(sat1, i + 1).Value = Cdbl(ListView1.ListItems(r).ListSubItems(i))

 

[ulutanas]

korhan hocam dediğiniz şekilde yaptım fakat bu sefer tarih dışında hiç birşeyi aktarmıyor. ekli dosyayı size zahmet düzeltebilirmisiniz nerede yanlış yaptıysam.

 

[Korhan Ayhan]

Merhaba,

Ben i = 5 değerini örnek olarak vermiştim. Siz alıp aynen uygulamışsınız. Bu şekilde tabi ki çalışmaz.

Kendi dosyanızda ki sütunları belirleyip ona göre kodu düzenlemelisiniz.

Kodlarınızda If-Then-Else-End If mantığını kullanmalısınız.

Artık makro kullanmaya başlamış bir üyemizin bu mantıkları kurması gerektiğini düşünüyorum.

Siz biraz daha araştırıp uğraşın. Bu şekilde farklı bilgilerde edinebilirsiniz. Yine de olmazsa yardımcı olurum.

 

[ulutanas]

Korhan hocam çok haklısınız çözemediğim noktada sitemizden yardıma başvurunca herşeyi sizlerden bekliyorum. Hal böyle olunca kendimi geliştirme konusunda başarısız oluyorum maalesef. Daha fazla araştırmak konun özünü incelemek benim için daha faydalı olacaktır muhakkak. ilginiz için çok teşekkürler.

Takıldığım noktada yine dönerim ama )

İyi çalışmalar...

Saygılarımla.

 

[ulutanas]

korhan hocam dediğiniz gibi vermiş olduğunuz biilgilere ve kod yardımına göre biraz daha kurcaladım rakam aktarım sorununu ortadan kalktı artık istediğim gibi rakamlar aktarılıyor kod aşağıdaki gibi oldu.

Private Sub CommandButton3_Click()
yer = "KAYIT_DEFTERİ"
sat1 = Worksheets(yer).[a65536].End(3).Row + 1
For r = 1 To ListView1.ListItems.Count + 1
Sheets(yer).Cells(sat1, 1).Value = ListView1.ListItems(r)
On Error Resume Next
For i = 0 To ListView1.ColumnHeaders.Count - 1
Sheets(yer).Cells(sat1, i + 1).Value = CDbl(ListView1.ListItems(r).ListSubItems(i))
Next i
sat1 = sat1 + 1
Next r

deger1 = 0
MsgBox "İŞLEM TAMAM", , "ULUTAN UYGUR"
End Sub

Fakat bu değişimle listviewde ki kelimelerin aktarımı iptal edildi onun içinde ayrı bir satır açıp ayrı bir kodmu girmek gerekiyor.

 

[ulutanas]

biraz daha kurcalamam gerekliymiş onuda hallettik.

kodumuzu aşağıdaki gibi değiştirdim hem kelimelerin hem sayısal değerleri sorunsuz aktarımını sağlamış olduk.

Private Sub CommandButton3_Click()
yer = "KAYIT_DEFTERİ"
sat1 = Worksheets(yer).[a65536].End(3).Row + 1
For r = 1 To ListView1.ListItems.Count + 1
Sheets(yer).Cells(sat1, 1).Value = ListView1.ListItems(r)
On Error Resume Next
For i = 0 To ListView1.ColumnHeaders.Count - 1
Sheets(yer).Cells(sat1, i + 1).Value = ListView1.ListItems(r).ListSubItems(i).Text
Sheets(yer).Cells(sat1, i + 1).Value = CDbl(ListView1.ListItems(r).ListSubItems(i))
Next i
sat1 = sat1 + 1
Next r
deger1 = 0
MsgBox "İŞLEM TAMAM", , "..."
End Sub


Korhan hocam sayenizde bir bilgi daha öğrendim emeğinize sağlık çok teşekkür ederim.

İyi çalışmalar...

Saygılarım.

 

[Korhan Ayhan]

Merhaba,

Sorununuzu araştırarak çözmenize sevindim. Fakat yanlış yöntem kullanmışsınız.

"On Error Resume Next" hataları giderse de kullanılmasını pek tasvip etmiyoruz. Tüm hataları engellediği için çalışmanızın can alıcı noktalarında size sorun yaratabilir.

Bunun yerine IF-THEN-ELSE-END IF mantığını kullanmanızda fayda var.

Aşağıdaki kod yapısını kullanabilirsiniz. Eksikleri olabilir.

Private Sub CommandButton3_Click()
    yer = "KAYIT_DEFTERİ"
    sat1 = Worksheets(yer).[a65536].End(3).Row + 1
    For r = 1 To ListView1.ListItems.Count
        Sheets(yer).Cells(sat1, 1).Value = CDate(ListView1.ListItems(r))
        For i = 1 To ListView1.ColumnHeaders.Count - 1
            If i = 1 Then
                Sheets(yer).Cells(sat1, i + 1).Value = CLng(ListView1.ListItems(r).ListSubItems(i))
            ElseIf i >= 6 And i <= 14 Then
                Sheets(yer).Cells(sat1, i + 1).Value = CDbl(ListView1.ListItems(r).ListSubItems(i))
            Else
                Sheets(yer).Cells(sat1, i + 1).Value = ListView1.ListItems(r).ListSubItems(i).Text
            End If
        Next i
        sat1 = sat1 + 1
    Next r
    
    deger1 = 0
    MsgBox "İŞLEM TAMAM", , "ULUTAN UYGUR"
End Sub

 

[ulutanas]

Korhan hocam teşekkürler dediğiniz gibi kodları uyguladım fakat bu şekilde kayıt yaparken aşağıda kodda hata veriyor. burayı anlamadım neden hata verdiğini.

Sheets(yer).Cells(sat1, i + 1).Value = CDate(ListView1.ListItems(r).ListSubItems(i))[/COLOR]

 

[Korhan Ayhan]

Üstteki mesajımda ki kodu güncelledim. Düzgün çalışması için döngüdeki tüm nesnelerin dolu olması gerekiyor.