Soru kapatma macrosuna pc adına göre sorgu ekleme

[incsoft]

Arkadaşlar aşağıdaki macro ile dosyam 20 dk kullanılmadığından kaydederek otomatik kapatmasını sağlıyorum. Buraya 2.bir koşul koyabilirmiyiz? Mesela sadece şu ıp numaralı bilgisayarda dikkat alma tüm hepsinde al ya da bilgisayar adı bu olanı dikkate alma gibisinden.



Option Explicit

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not IsEmpty(CloseDownTime) Then
Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
End If
End Sub




Option Explicit
Public CloseDownTime As Variant

Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:20:00") hh:mm:ss
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub

Public Sub CloseDownFile()
On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=True
End Sub

 

[AdemCan]

Merhaba, paylaştığınız kodları deneme imkanım yok ama CloseDownFile kodunu paylaştığım kod ile değiştirip dener misiniz?

Bilgisayar Adını Buraya Yazınız kısmına dosyanın kapanmasını istemediğiniz bilgisayarın adını yazınız.

Public Sub CloseDownFile()
On Error Resume Next
If Environ("ComputerName") <> "Bilgisayar Adını Buraya Yazınız" Then
    Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
    ThisWorkbook.Close SaveChanges:=True
End If
End Sub

 

[incsoft]

Merhaba, paylaştığınız kodları deneme imkanım yok ama CloseDownFile kodunu paylaştığım kod ile değiştirip dener misiniz?

Bilgisayar Adını Buraya Yazınız kısmına dosyanın kapanmasını istemediğiniz bilgisayarın adını yazınız.

Public Sub CloseDownFile()
On Error Resume Next
If Environ("ComputerName") <> "Bilgisayar Adını Buraya Yazınız" Then
    Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
    ThisWorkbook.Close SaveChanges:=True
End If
End Sub

hocam öncelikle teşekkürler ancak sanki olmuyor gibi.. Mesela

If Environ("ComputerName") <> "UFUK" Then

dediğim de bilgisayar adı UFUK olanıda kapatıyor

 

[AdemCan]

On Error Resume Next satırı koşulu pasif yapıyor. Bu satırı iptal edip dener misiniz?

 

[incsoft]

On Error Resume Next satırı koşulu pasif yapıyor. Bu satırı iptal edip dener misiniz?

onu da yemedi Adem bey yine kapatıyor

 

[AdemCan]

Dosyanızı paylaşır mısınız?

 

[incsoft]

On Error Resume Next satırı koşulu pasif yapıyor. Bu satırı iptal edip dener misiniz?

bunda da ne yaparsam kapattıramadım.Ne tuaf

 

[incsoft]

Dosyanızı paylaşır mısınız?

site dosya eklemiyor altın üye olmama rağmen

 

[Korhan Ayhan]

Dosyanızın uzantısını site desteklemiyorsa eklemenize müsade etmez. Winrar ile sıkıştırıp ekleyebilirsiniz.

 

[incsoft]

Dosyanızın uzantısını site desteklemiyorsa eklemenize müsade etmez. Winrar ile sıkıştırıp ekleyebilirsiniz.

onuda denedim olmuyor Korhan bey

 

[Korhan Ayhan]

Bu bir denemedir.

 

[EmrExcel16]

Test amaçlıdır, sanki aynı durum bende de var dosya ekleyemiyorum.

 

[incsoft]

Test amaçlıdır, sanki aynı durum bende de var dosya ekleyemiyorum.

siz eklemisiniz ben ekleyemedim

 

[Korhan Ayhan]

Aşağıdaki gibi denediğimde sanki oldu gibi..

Public Sub CloseDownFile()
    Select Case Environ("ComputerName")
        Case Is <> "User_1", Is <> "User_2"
            On Error Resume Next
            Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
            ThisWorkbook.Close SaveChanges:=True
    End Select
End Sub