listedekileri excelle gönder

[akd]

Merhaba arkadaşlar,
Aşağıdaki kodlarla form üzerindeki listbox takileri bir excel kitabı oluşturup sayfa birine yazdırtıyorum, yalnız bu oluşum çok uzun sürüyor.
birde win xp de sorun çıkartıyor, yani çalışmıyor.
Teşekkürler...
Set w = Application.Workbooks.Add
Set s = w.Worksheets(1)
For i = 0 To ListBox1.ListCount - 1
For j = 0 To ListBox1.ColumnCount - 1
s.Cells(i + 1, j + 1) = ListBox1.List(i, j)
Next j
Next i
w.SaveAs ("c:\" & (TextBox3.Text) & ".xls")
MsgBox " C:\ Klasörü içerisine " & (TextBox3.Text) & " Adında Bir Excel Kitabı oluşturulmuştur...", vbDefaultButton1, "AKD.YAZILIM"

 

[Haluk]

Kodun çalışma süresini uzatan olay; iç içe For - Next döngülerinin olması.

Bu sürenin kısalması için, bir de şöyle deneyin;

[vb:1:f36ab12fd5]Set w = Application.Workbooks.Add
Set s = w.Worksheets(1)
nRow = ListBox1.ListCount
s.Range("A1", "J" & nRow) = ListBox1.List
w.SaveAs ("c:\" & (TextBox3.Text) & ".xls")
MsgBox " C:\ Klasörü içerisine " & (TextBox3.Text) & " Adında Bir Excel Kitabı oluşturulmuştur...", vbDefaultButton1, "AKD.YAZILIM"
[/vb:1:f36ab12fd5]

 

[akd]

Merhaba Sayın Raider,
Elinize sağlık kod çok hızlı olmuş, yalnız listede 5 sutun varsa excel sayfasına aktarırken bu bigi olan 5 sutunun haricinde, 5 tanede #YOK
yazılı sutun oluşturuyor.
Buna nasıl bir düzeltme yaparız.
Saygılar...

 

[Haluk]

[vb:1:74198826be]Set w = Application.Workbooks.Add
Set s = w.Worksheets(1)
nRow = ListBox1.ListCount
nColumn = ListBox1.ColumnCount
s.Range("A1", Cells(nRow, nColumn).Address) = ListBox1.List
w.SaveAs ("c:\" & (TextBox3.Text) & ".xls")
MsgBox " C:\ Klasörü içerisine " & (TextBox3.Text) & " Adında Bir Excel Kitabı oluşturulmuştur...", vbDefaultButton1, "AKD.YAZILIM"
[/vb:1:74198826be]

 

[akd]

Merhaba sayın raider
Elinize sağlık çok güzel olmuş çok çok teşekkürler.

İzin verirseniz size bir soru daha sorabilirmiyim,
Bu oluşturulan kitap o anda aktif oluyor , acaba bu oluşturulan kitabın aktif olmasını nasıl engelleriz.
Yani kitabı oluştursun ama açmasın...
Saygılar...

 

[Haluk]

O zaman, bir de bunu deneyin...

[vb:1:882b739a86]Private Sub CommandButton1_Click()
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set NewWB = xlApp.Workbooks.Add
Set MySh = NewWB.Worksheets(1)
nRow = ListBox1.ListCount
nColumn = ListBox1.ColumnCount
MySh.Range("A1", Cells(nRow, nColumn).Address) = ListBox1.List
WBname = "C:\" & (TextBox3.Text) & ".xls"
NewWB.SaveAs WBname
MsgBox WBname & " Adında Bir Excel Kitabı oluşturulmuştur...", _
vbInformation, "AKD.YAZILIM"
xlApp.Quit
Set xlApp = Nothing
Set MySh = Nothing
Set NewWB = Nothing
End Sub
[/vb:1:882b739a86]

 

[akd]

sayın raider çok çok çok teşekkürler,
Herşey gönlünce olsun...