Macro ile çalışma kitabını paylaştırma komutu

[safaari]

Merhaba.
Macro ile çalışma kitabını paylaştır komutu varmıdır ?

Yardımlarınız için teşekkürler.

 

[mancubus]

dosya isimlerini kendi durumunuza uyarlayın.

paylaşıma açmak:

Sub paylas()

    Dim wbk As Workbook
    Set wbk = Workbooks("Norm_Dos")
    
    wbk.SaveAs "Pay_Dos", , , , , , xlShared

End Sub

aylaşımı kaldırmak:

Sub pay_kaldir()

    Dim wbk As Workbook
    Set wbk = Workbooks("Pay_Dos.xls")
    
    If wbk.MultiUserEditing Then
        wbk.ExclusiveAccess
    End If

    wbk.SaveAs "Norm_Dos"
'    wbk.Save 'aynı isimle (Pay_Dos) kaydetmesi için
End Sub

 

[safaari]

İlgilendiğiniz için çok sağlun fakat benim dosya ismi sürekli değişiyor.
Ben değişken dosya ismi için paylaşımı kaldırma komutunu aşağıdaki gibi yaptım fakat
geri paylaşımı veremiyorum.

' Paylaşımı kaldırıyor.
ActiveWorkbook.ExclusiveAccess

 

[mancubus]

tam anlyamadım. ama aynı isimde paylaşıma tekrar açmak için.

If Not ActiveWorkbook.MultiUserEditing Then
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
End If

uyarı mesajları çıkmadan kod çalışsın derseniz:

Application.DisplayAlerts = False

If Not ActiveWorkbook.MultiUserEditing Then
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
End If
    
Application.DisplayAlerts = True

 

[safaari]

' Paylaşımı kaldırıyor.
ActiveWorkbook.ExclusiveAccess

' Paylaşım veriyor.
If Not ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
End If

' Paylaşım kaldırıken soru pencereleri çıkmaması için
Application.DisplayAlerts = False
(Bu araya paylaşım kaldırma ve verme komutunu yazdım.)
Application.DisplayAlerts = True

Sorunum çözüldü.
Çok sağlun teşekkür ediyorum. Sorunumu sizin sayenizde yine çözdüm. İyi varsınız.