dosya read only ise açılmasın

[ildizim]

bir excel dosyam var içerisinde bir sürü macro var.
server altından bircok kullanıcı bu dosyayı kullanabiliyor .

şu an dosyayı biri açmış kullanırken başkası tıkladığında read only uyarısı veriyor ve kullanabiliyor.

İSTEDİĞİM ŞU :
eger dosya kullanılıyorsa başka bir kullanıcı açmaya çalıştıgında dosya kullanıyor sonra deneyin gibi bir msg box cıkması ve dosyanın kapanması.

 

[ildizim]

mutlaka pratik bir çözümü vardır yardımlarınızı bekliyorum.
teşekkürler.

 

[Levent Menteşoğlu]

Diyelimki dosyanızın adı "deneme.xls" ve yoluda "c:\" olsun. Aşağıdaki kodu deneyin.

Sub uyari()
Workbooks.Open "C:\deneme.xls"
If Workbooks("deneme.xls").ReadOnly = True Then
MsgBox "DOSYA KULLANIMDADIR"
Workbooks("deneme.xls").Close
End If
End Sub

 

[ildizim]

dosya benim d:\macro\numaratör altında numaratör.xls
ve diğer kullanıcalar benim pcye map olu dosyayı açmaya çalışıyorlar.

numaratör xls tıklanınca autoopenl a userform1'e gidiliyor ve dosya userform1'de açılıyor verdiğiniz kodu şu şekilde userform1'in en tepesine yazdım.

Sub uyari()
Workbooks.Open "d:\macro\numaratör\numaratör.xls"
If Workbooks("numaratör.xls").ReadOnly = True Then
MsgBox "DOSYA KULLANIMDADIR"
Workbooks("numaratör.xls").Close
End If
End Sub

biryerde hatamı yaptım? çünkü read onlyde yine açılıyor.

 

[tevfikdemir]

Bu kodu workbook_open bölümüne yazmanız gerekir.Userforma yazarsanız program oraya gelebilmesi için zaten önce acılması gerekir.
Private Sub Workbook_Open()

Workbooks.Open "C:\deneme.xls"
If Workbooks("deneme.xls").ReadOnly = True Then
MsgBox "DOSYA KULLANIMDADIR"
Workbooks("deneme.xls").Close
End If

End Sub

 

[ildizim]

YİNE OLMADI
HALA READ ONLY UYARISI VERİYOR AMA AÇILIYOR DOSYA.

 

[Levent Menteşoğlu]

Muhtemelen kodu yanlış yere kopyalıyorsunuz. yukarıda userformdan bahsetmişsiniz, userformda dosyanı hangi kodlarla açtığınızı verirseniz onun üzerinden gidebiliriz.

 

[ildizim]

levent ekli dosya ile bakarsan belki daha kolay sorunu tesbit edebilirsin yine yanlış yönlendirmeyim siz.
teşekkürler.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub Auto_Open()
Workbooks.Open "d:\macro\numaratör\numaratör.xls"
If Workbooks("numaratör.xls").ReadOnly = True Then
MsgBox "DOSYA KULLANIMDADIR. LUTFEN SONRA DENEYINIZ"
Workbooks("numaraör.xls").Close
End If
UserForm1.Show
End Sub

 

[yesilcan]

arkadaşlar yardım rica ediyorum.

bu kodları uyguladım fakat workbook sayfamda aşağıdaki kodlar mevcut.bu kodlar varken uyguladığımda dosya kullanımda uyarı veriyor ama dosyayı açıp kapatmıyor.yardımlarınızı rica ediyorum.lütfen

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
If deg = 1 Then Exit Sub
Cancel = True
MsgBox "LÜTFEN SAYFA ÜZERİNDEKİ KAPAT BUTONUNDAN KAPATIN."
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If deg1 = 1 Then Exit Sub
Cancel = True
MsgBox "LÜTFEN SAYFA ÜZERİNDEKİ YAZDIR BUTONUNDAN YAZDIRIN."
End Sub

 

[yesilcan]

hocalarım yardım lütfen

değerli hocalarım biliyorum şu birkaç gün içersinde foruma epey bir soru gönderdim sağolsun arkadaşlarım ve hocalarım yardımlarını esirgemediler.bir proje üzerinde çalışıyorum ve eksik tamamlayamadım bazı yerleri soru olarak gönderiyorum.anlayışınız ve sabrınızdan ötürü sizlere teşekkür ederim.zannediyorum bu soru bu projem için son olacak.tabiki şunuda biliyorum ve inanıyorum ki benim gibi yardıma ihtiyacı olan bir çok arkadaşım var.Bu forumdan yaralanmak onlarında hakkı.ama projem için verilen süre dolmak üzere bu sorumda yanıtlanırsa dosyamda sadece görünümlerini tamamlayıp sunuş yapmak kalıyor.bu sorumun çözümlenmesi için yardımlarınıza ihtiyacım var.lütfen rica ediyorum.

 

[Levent Menteşoğlu]

Dosyayı kapattığınız butondaki kodları verirmisiniz.

 

[Orion1]

Kapatma ile ilgli şöyle yapabilirsiniz.
deg adlı değişkeni Boş bir modülde aşağıdaki gibi tanımlayın

Public deg as byte

Kapat butonuna aşağıdaki kodları yazın.

[B]deg=1 [/B] 
[B]thisworkbook.close[/B]

Aşağıdaki kodları uygulayınız.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
If deg = 0 Then 
Cancel = True
MsgBox "LÜTFEN SAYFA ÜZERİNDEKİ KAPAT BUTONUNDAN KAPATIN."
end if
End Sub

 

[yesilcan]

levent hocam ;

Dosyayı kapattığım butondaki kodlar

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
If deg = 1 Then Exit Sub
Cancel = True
MsgBox "LÜTFEN SAYFA ÜZERİNDEKİ KAPAT BUTONUNDAN KAPATIN."
End Sub

 

[Levent Menteşoğlu]

Ben sayfa üzerindeki KAPAT butonundaki kodları kasdetmiştim.

 

[yesilcan]

hocam çok afedersin.özür dilerim yanlış anladım.buyrun

Public deg As Integer
Sub kapa()
deg = 1
MsgBox "BU DOSYA SERDAR TARAFINDAN HAZIRLANMIŞTIR.", , "ESKİŞEHİR"
ActiveWorkbook.Close True
End Sub

 

[Levent Menteşoğlu]

Benim yukarıda verdiğim koda aşağıdaki kırmızı renkli satırı ilave ederek deneyin.

[LEFT]Sub Auto_Open()
Workbooks.Open "d:\macro\numaratör\numaratör.xls"
If Workbooks("numaratör.xls").ReadOnly = True Then
MsgBox "DOSYA KULLANIMDADIR. LUTFEN SONRA DENEYINIZ"
[COLOR=red][B]deg=1
[/B][/COLOR]Workbooks("numaraör.xls").Close
End If
UserForm1.Show
End Sub[/LEFT]