ProgressBar ile Makro senkronize çalışsın

[vivident]

Merhaba

Listboxdaki verileri excel sheetine aktarıyorum. Aktarma anındaki bekleme süresini ProgressBar yaparak daha görsel olmasını istiyorum

Ekteki örnekte kodda "son=10000" değerini azaltırsam ProgressBar daha hızlı çalışıyor. Ben bu değerle oynamayıp excele veriler aktarılırken ProgressBarla birlikte senkronize çalışmasının sağlamanmasını istiyorum. Nasıl yapılabilir
Veri aktarma kodlarımıda örnek dosyada belirttim

Dim L As Long, son As Long
son = 10000
For L = 1 To son
DoEvents
Me.Caption = "İşlem durumu : % " & Fix((L / son) * 100)
Label1.Width = (L / son) * Frame1.Width

 

[Muzaffer Ali]

Programlamada aslolan mantık hızlı çalışmasıdır görsellik ikinci planda kalır.

Yinede bunu yapmak istiyorsanız

son = 10000 - listview1.list.coun

dersiniz

daha sonra
listview1.list.coun
adeti kadar yeniden döngü yaparak progresbarınızı ilerletebilirsiniz.

 

[vivident]

Sayın dalgalıkur

Örneğin ; ListBox1.ListCount sayısı 50 diyelim
Kodda
son = 10000 - 50 oluyor

Daha sonra (ListBox1.ListCount ) 50 adet kadar yeni döngüyü nasıl yapıyoruz. Bir örnek verebilirmisiniz. Yukarıda verilen kodda hangi alanı değiştireceğim

 

[vivident]

Birde listboxdan excele verileri taşımak için aşağıdaki kodları kullanıyorum. Şu anda listboxda 10 satır veri girişi var. Ama excele gönderirken 45-60 saniye bekliyorum, Bu normal bir şey mi

Private Sub CommandButton2_Click() 'Excele aktar
Application.ScreenUpdating = False
Dim sat As Long
sat = 9
For i = 0 To Me.ListBox1.ListCount - 1
Range("B" & sat).Value = Me.ListBox1.List(i, 0)
Range("E" & sat).Value = Me.ListBox1.List(i, 1)
Range("I" & sat).Value = Me.ListBox1.List(i, 2)
Range("H" & sat).Value = Me.ListBox1.List(i, 3)
Range("G" & sat).Value = Me.ListBox1.List(i, 4)
Range("J" & sat).Value = Me.ListBox1.List(i, 5)
Range("K" & sat).Value = Me.ListBox1.List(i, 6)
Range("M" & sat).Value = Me.ListBox1.List(i, 7)
Range("S" & sat).Value = Me.ListBox1.List(i, 8)
Range("P" & sat).Value = Me.ListBox1.List(i, 9)
Range("O" & sat).Value = Me.ListBox1.List(i, 10)
Range("V" & sat).Value = Me.ListBox1.List(i, 11)
Range("W" & sat).Value = Me.ListBox1.List(i, 12)
Range("AA" & sat).Value = Me.ListBox1.List(i, 13)
Range("AB" & sat).Value = Me.ListBox1.List(i, 14)
Range("F" & sat).Value = Me.ListBox1.List(i, 15)
Range("L" & sat).Value = Me.ListBox1.List(i, 16)
Range("N" & sat).Value = Me.ListBox1.List(i, 17)
Range("R" & sat).Value = Me.ListBox1.List(i, 18)
Range("T" & sat).Value = Me.ListBox1.List(i, 19)
Range("U" & sat).Value = Me.ListBox1.List(i, 20)
Range("Q" & sat).Value = Me.ListBox1.List(i, 21)
Range("Y" & sat).Value = Me.ListBox1.List(i, 22)
Range("X" & sat).Value = Me.ListBox1.List(i, 23)
sat = sat + 1
Next i
Application.ScreenUpdating = True
MsgBox "<< Bilgi Mesajı >>" & vbLf & _
        "Excel'e Veriler Aktarıldı", vbInformation
End Sub

 

[hımmmmmmmm]

aynı yere 2 kez işlem yapıyor olabilir...
excele taşıdığın alan 'listbox1.rowsource' da tanımlı ise temizlemeyi dene...


listbox1.rowsource="" 'row sorsu temizler

 

[vivident]

aynı yere 2 kez işlem yapıyor olabilir...
excele taşıdığın alan 'listbox1.rowsource' da tanımlı ise temizlemeyi dene...


listbox1.rowsource="" 'row sorsu temizler

Listbox1.rowsource'de tanımlı bir şey yok. Zaten accessten listboxa veri alıyorum. Çözemedim

 

[karotis]

Dim L As Long, son As Long
son = 10000
For L = 1 To son
DoEvents
Me.Caption = "İşlem durumu : % " & Fix((L / son) * 100)
Label1.Width = (L / son) * Frame1.Width

son=Me.ListBox1.ListCount mantığında yapsan olacak gibi düşünüyorum

 

[Muzaffer Ali]

Döngününü 1000'e tamamlanması için

    For L = Label1.Width To son + ListBox1.ListCount
    
    Next

Yavaş çalışan kodların değerleri yazdığı sayfada Change yada başka bir olayı çalışıyor olabilir kontrol edin.

 

[vivident]

Sayın dalgalikur sistem neden yavaş çalıştığını buldum. Şimdi mükemmel hızlı çalışıyor. Ama ben yine de listbox ile uyumlu progressbar kullanmak istiyorum

Lakin verdiğiniz kodu çalıştıramadım. Dosyamı ekledim
Yardımcı olursanız memnun olurum

 

[Muzaffer Ali]

Dosyanız ekte

 

[vivident]

Sayın dalgalikur çok teşekkürler, elinize sağlık

 

[vivident]

Sayın dalgalikur bi problem farkettim

İşlem durumu : % 101 olarak görülüyor
Bar'ın backcolor rengi maviden %100 geçince tekrar sarı renge dönüyor. Acaba % 101 probleminde mi kaynaklanıyor

 

[vivident]

Sayin dalgalikur 12 nolu mesajımda belirttiğim problemleri çözdüm.

İşlem durumu problemini koda "-1" ekleyerek %100 olmasını sağladım
son = 1000 - UserForm0.ListBox1.ListCount
For L = Label1.Width To son + UserForm0.ListBox1.ListCount - 1

Bar'ın backcolor rengi maviden tekrar sarı renge dönme problemini kırmızı renkteki satırı çıkaracak çözdüm
For i = 0 To .ListBox1.ListCount - 1
'Label1.Width = (Label1.Width / son) * Frame1.Width
Range("B" & sat).Value = .ListBox1.List(i, 0)

Kodu çalıştırdığımda sorun yaşamadım, ama yinede öğrenmek istiyorum, yaptığım işlemler doğrumudur ? Farklı bir yerleri etkilemiş olabilirmiyim

 

[Muzaffer Ali]

Hayır bir sorun görünmüyor.