- Katılım
- 19 Mayıs 2015
- Mesajlar
- 239
- Excel Vers. ve Dili
- 2010 türkçe
- Altın Üyelik Bitiş Tarihi
- 09-07-2021
Herkese merhaba,
Aşağıdaki kodun yüklü olduğu sayfa başka bir excell sayfası açıkken kapatıldığında kod içindeki tanımlı süre sonunda (10 sn) kendini tekrar açıyor.Bunu önlemenin bir yolu varmı?Yazılan kod yüzünden mi oluyor?
Teşekkürler
Aşağıdaki kodun yüklü olduğu sayfa başka bir excell sayfası açıkken kapatıldığında kod içindeki tanımlı süre sonunda (10 sn) kendini tekrar açıyor.Bunu önlemenin bir yolu varmı?Yazılan kod yüzünden mi oluyor?
Teşekkürler
Kod:
Sub auto_open()
Call clock
End Sub
Sub clock()
Application.OnTime Now + TimeValue("00:00:10"), "hesapla"
End Sub
Sub hesapla()
Dim wb_Numune, wb_Parametre As Workbook
For Each vb In Workbooks
If vb.Name = "NUMUNE KABUL VE KAYIT 1.xlsm" Then
Set wb_Numune = Application.Workbooks(vb.Name)
End If
If vb.Name = "Parametre Dağılım 1.xlsm" Then
Set wb_Parametre = Application.Workbooks(vb.Name)
End If
Next
If IsEmpty(wb_Numune) Then
'Numune Sayfası açık değil
GoTo son:
End If
s = Array("", "NUMUNE NO 1", "NUMUNE NO 2", "NUMUNE NO 3")
Dim S1, S2 As Worksheet
Set S2 = wb_Parametre.Sheets("parametre dağılım")
S2.Range("I2") = Format(Now, "hh:mm:ss")
S2.Range("A4:AN" & Rows.Count).ClearContents
For i = 1 To UBound(s)
Set S1 = wb_Numune.Sheets(i)
son = S1.Cells(Rows.Count, "E").End(3).Row
For Each alan In S1.Range("H5:AP" & son)
If UCase(alan) = "X" Then
sat = S2.Cells(Rows.Count, alan.Column - 2).End(3).Row + 1
S2.Cells(sat, alan.Column - 2) = S1.Cells(alan.Row, "E")
End If
Next
Next i
son:
Call clock
End Sub