listview'den excel sayfasına sayı formatında aktarım sorunu

[wolkss]

Arkadaşlar merhaba;
Aşağıda örneği bulunan çalışmamda tarihli yevmiye fişi çekmek istediğim zaman FIS_GIRISI sayfasından verileri süzdürerek userform üzerindeki listviewe getirtebiliyorum ancak fişi yazdır butonuna tıkladığımda listview'den excel içindeki YEVMIYE_FISI sayfasına aktarımı yaparken J,K,L,M,N,O sütunlarının metin formatı ile değil de sayı formatı ile aktarılmasını yapamadım.İlgilenen tüm arkadaşlarıma teşekkür ederim...

 

[halit3]

CommandButton4 deki aşağıdaki kodu

Sheets("YEVMIYE_FISI").Cells(i + 1, ss + 1).Value = Me.ListView1.ListItems(i).ListSubItems(ss) 'Sıra no

bununla değiştiriniz.

If ss <= 7 Then
Sheets("YEVMIYE_FISI").Cells(i + 1, ss + 1).Value = Me.ListView1.ListItems(i).ListSubItems(ss)
Else
Sheets("YEVMIYE_FISI").Cells(i + 1, ss + 1).Value = Me.ListView1.ListItems(i).ListSubItems(ss) * 1
End If

 

[halit3]

kodu başka türlü düzenledim.

Private Sub CommandButton4_Click()
Sheets("YEVMIYE_FISI").Cells.ClearContents
yer = "YEVMIYE_FISI"
sat1 = 2 'Worksheets(yer).[a65536].End(3).Row + 1
Application.ScreenUpdating = True
For n = 1 To Val(ListView1.ColumnHeaders.Count) - 1
Sheets(yer).Cells(1, n).Value = ListView1.ColumnHeaders.Text
Sheets(yer).Cells(1, n).Font.Bold = True
Next
For r = 1 To ListView1.ListItems.Count + 1
On Error Resume Next
For i = 0 To ListView1.ColumnHeaders.Count - 1
On Error Resume Next
If i = 0 Then
Sheets(yer).Cells(sat1, 1).Value = ListView1.ListItems(r).Text
End If
If IsNumeric(ListView1.ListItems(r).ListSubItems(i).Text) = False Then
Sheets(yer).Cells(sat1, i + 1).Value = ListView1.ListItems(r).ListSubItems(i).Text
Else
'MsgBox Len(ListView1.ListItems(r).ListSubItems(i).Text) & " " & ListView1.ListItems(r).ListSubItems(i).Text
If Len(ListView1.ListItems(r).ListSubItems(i).Text) = 10 Then
Sheets(yer).Cells(sat1, i + 1).Value = ListView1.ListItems(r).ListSubItems(i).Text
Else
Sheets(yer).Cells(sat1, i + 1).Value = ListView1.ListItems(r).ListSubItems(i).Text * 1
End If
End If
Next i
sat1 = sat1 + 1
Next r
Sheets("YEVMIYE_FISI").Cells(1, 15).Value = Me.ListView1.ColumnHeaders(15) 'başlık
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı"
Sheets("YEVMIYE_FISI").Select
Range("A1:O65536").Select

'ActiveSheet.PageSetup.PrintArea = "$A$1:$O$65536"
Application.ScreenUpdating = False
Application.Visible = True
Application.ScreenUpdating = True
Unload UserForm13
Unload UserForm1

End Sub

 

[wolkss]

Halit Bey ilginiz için teşekkür ederim.Ancak;
2. mesajınızdaki kodu denediğim zaman hata veriyor ve

Sheets("YEVMIYE_FISI").Cells(i + 1, ss + 1).Value = Me.ListView1.ListItems(i).ListSubItems(ss) * 1
End If

kodunu sarı renkle belirtiyor
3. mesajınızdaki kodu denediğim zaman sayfanın bütün ayarları kayıyor.

 

[halit3]

kendi kodunu düzelttim.

Private Sub CommandButton5_Click()
Sheets("YEVMIYE_FISI").Cells.ClearContents
Application.ScreenUpdating = True
For ss = 1 To 14 'Başlık için dönüyor
Sheets("YEVMIYE_FISI").Cells(1, ss).Value = Me.ListView1.ColumnHeaders(ss) 'başlık
For i = 1 To Me.ListView1.ListItems.Count 'Sıra numarası için dönüyor
If ss = 1 Then
Sheets("YEVMIYE_FISI").Cells(i + 1, 1).Value = Me.ListView1.ListItems(i) 'Sıra no
End If
If ss <= 7 Then
Sheets("YEVMIYE_FISI").Cells(i + 1, ss + 1).Value = Me.ListView1.ListItems(i).ListSubItems(ss)
Else
Sheets("YEVMIYE_FISI").Cells(i + 1, ss + 1).Value = Me.ListView1.ListItems(i).ListSubItems(ss) * 1
End If

Next i, ss
Sheets("YEVMIYE_FISI").Cells(1, 15).Value = Me.ListView1.ColumnHeaders(15) 'başlık
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı"
Sheets("YEVMIYE_FISI").Select
Range("A1:O65536").Select

'ActiveSheet.PageSetup.PrintArea = "$A$1:$O$65536"
Application.ScreenUpdating = False
Application.Visible = True
Application.ScreenUpdating = True
Unload UserForm13
Unload UserForm1
End Sub

 

[halit3]

her iki koduda düzenledim

 

[wolkss]

Halit Bey ellerinize sağlık çok güzel oldu. Yardımlarınız için çok teşekkür ederim.

 

[halit3]

Halit Bey ellerinize sağlık çok güzel oldu. Yardımlarınız için çok teşekkür ederim.

iyi çalışmalar

 

[kemalist]

iyi çalışmalar

sayın halit biliyorum yanlış yerdeyim ama şu lingteki sorunuma bi el atsanız.ilginiz için şimdiden çok teşekkür ederim.
dosya ektedir

http://www.excel.web.tr/showthread.php?p=483032#post483032