Makroyu durdurmak

[vivident]

Arkadaşlar userform aktif iken döngü başlıyor ve lsitboxa acceste veri alıyorum, kodun altınada, "UserForm_Activate" ekledim ve döngü sonsuza kadar gidiyor, fakat ben userfomu kapattığım zamanda bazen döngü devam ediyor. Userform kapatılırken döngüyü durdur nasıl diyebiliriz

Private Sub UserForm_Activate()
basla = Timer
While Timer - basla < 10
DoEvents
Wend
Listboxa_Aktar
UserForm_Activate
End Sub

 

[halit3]

Arkadaşlar userform aktif iken döngü başlıyor ve lsitboxa acceste veri alıyorum, kodun altınada, "UserForm_Activate" ekledim ve döngü sonsuza kadar gidiyor, fakat ben userfomu kapattığım zamanda bazen döngü devam ediyor. Userform kapatılırken döngüyü durdur nasıl diyebiliriz

Private Sub UserForm_Activate()
basla = Timer
While Timer - basla < 10
DoEvents
Wend
Listboxa_Aktar
UserForm_Activate
End Sub

bu bölümü kodun içine niye eklediniz

UserForm_Activate

 

[vivident]

Halit bey sürekli döngü devam etsin diye ekledim, öbür türlü listboxa bir kez aktarma işlemi yapıyordu bir daha yapmıyordu

 

[halit3]

Userformun içine bir adet timer nesnesi 2 adet komut duğmesi ekleyin ve komut düğmelerin birine tıklayın çalışacaktır diğeride durdurma işlemi yapmaktadır.

bu kodları bir deneyin.

Private Sub CommandButton1_Click()
'çalıştır
Timer1.Enabled = True
Timer1.Interval = 1000
End Sub

Private Sub CommandButton2_Click()
'durdur
Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
Dim sure As String
sure = 5 ' saniye
deg = Format(Now, "ss")
If deg Mod sure = 1 Then
'Kodlarınız buraya yazılacak
Listboxa_Aktar
End If
End Sub

Private Sub UserForm_Activate()
CommandButton1_Click
End Sub

 

[vivident]

Userform içerisinde herhangi bir butona basarak kodun durmasını istemiyorum, userform kapanırken otomatik dursun yeterli benim için

Halit bey ben dosyamı ekledim. Yapmaya çalıştığım ; ağda dosya üzerinde kimler çalışıyor ise online olarak görmek. Eğer kodda "UserForm_Activate kısmını çıkarırsam, bir kez döngü kuruluyor veya dosyadan çıkışta, çıkan kişi "offline" olarak görülüyor. (offline görülmesi gerekli)

Lakin UserForm_Activate kısmını çıkarmazsam (ki istediğim sürekli bağlantı kurması) bu kez dosyadan çıkış yaptığımda, dosya içerisinde halen "online" olarak görülüyorum

Benim isteğim döngünün sonsuz olarak çalışması, lakin userform kapandığında döngününde bitmesi, döngü biterse sanıyorum ki bu online, offline problemide çözülecek. Dosyanın yedeğini alarak birkaçkez deneme yapın, hatayı farkedeceksiniz

 

[halit3]

ekli dosyayı irdeleyiniz.

 

[vivident]

Halit bey ilk açılışta hata aldım, sanıyorum ki birşeyler bende yüklü değil

 

[halit3]

Halit bey ilk açılışta hata aldım, sanıyorum ki birşeyler bende yüklü değil

Bu linkdeki uygulamaları yap

http://www.excel.web.tr/f167/timer-nesnesinin-kurulumu-t78713.html

 

[vivident]

Halit bey şimdi bittiğim andır, çünkü PC şirkete ait olduğu için windowsun altına erişimimiz engelli.

 

[halit3]

birde bu dosyayı dene

 

[vivident]

Halit bey dosyayı açamadım %100 oluyor ve açılmıyor. Sizi de uğraştırdım, kusura bakmayın

Halit bey, döngüyü silerek tekrar deneyeyim diye düşündüm, sanıyorum benim problemim döngü ile çözülmeyecek. Dosya ilk açıldığında UserForm2.TextBox1 = UserForm1.ListBox1.ListCount kodu ile sıra numarası alıyorum. Dosya kapanırken de bu sıra numarası ile acceste güncelleme yapıyorum.

Nasıl oluyor bilmiyorum ama sıra no bazen rakam değeri alıyor, bazen sıfır oluyor, acaba döngüden midir felan diye düşündüm, sabahtan beri döngüyü ile oynuyorum, döngüyü sildim, ama malesef sıra no döngüye bağlı değil diye düşünüyorum

 

[halit3]

Userformun içindeki kodlar bu

Private Sub Listboxa_Aktar()
ListBox1.Clear
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

Set baglan = CreateObject("adodb.connection")
baglan.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\TakvimList.mdb"

rs.Open "select Kullanici,Durum,format(Giris,'hh:mm'),format(Cikis,'hh:mm'),Kimlik from [TakvimList] Order By Kimlik Desc", baglan, 1, 1
With ListBox1
.RowSource = Empty
.ColumnCount = 4
.ColumnWidths = "60;60;50;50"
.Column = rs.getrows
End With
rs.Close
Set baglan = Nothing: Set rs = Nothing
ListBox1.MultiSelect = 1
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Column(1, i) = "Online" Then
ListBox1.Selected(i) = True
End If
Next i
End Sub
Private Sub CommandButton1_Click()
ListBox1.Clear
End Sub

Private Sub CommandButton2_Click()
atla:
Dim basla
Dim bekle
ListBox1.Clear

Listboxa_Aktar

Dim Bak As Integer
Dim Say_Online As Integer
Say_Online = 0
For Bak = 0 To UserForm1.ListBox1.ListCount - 1
If UserForm1.ListBox1.List(Bak, 1) = "Online" Then
Say_Online = Say_Online + 1
End If
Next
UserForm1.TextBox1.Text = "Online Kullanıcı " & Say_Online & " Kişi"

basla = Timer
bekle = 5
While Timer < basla + bekle
DoEvents
Wend

GoTo atla
End Sub

Private Sub UserForm_Initialize()
UserForm1.Show 0
CommandButton2_Click
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
End
End Sub

 

[vivident]

Halit bey kodları alıp denedim. Dosyayı kapatırken yine kilitlenme oldu. Yardımlarınızı için tesekkur ederim