Départager départager en mode VBA

[erwanhavre]

Bonjour à tous
Existe-t-il un bout de code pour départager un classeur ?
Je tente une explication
J'ai créé un espèce de formulaire qui par le biai d'un code VBA créer une copie du classeur avec le nom qui est dans une cellule de la feuille sélectionné + d'autres action .... j'ai le code pour enlever toute la création VBA et module, mais je ne peut pas aller plus loin car le fichier est partagé en clair mon fichier qui me sert de matrice dois lui et de partager mais le dossier créé via la matrice doit lui être sans partage

 

[MASSJIPE]

Bonsoir
moi j'utilise ceci

Sub Départage()
'
' Mode SHARED "OFF" à l'ouverture
If ActiveWorkbook.MultiUserEditing Then
Application.DisplayAlerts = False ' Pas de message d'erreur
ActiveWorkbook.ExclusiveAccess ' Accès exclusif activé !
Application.DisplayAlerts = True
End If
End Sub
Sub Partarge()

'Sauvegarde en réactivant le partage !
If Not ActiveWorkbook.MultiUserEditing Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
Application.DisplayAlerts = True
End If
End Sub

 

[erwanhavre]

Bonsoir
moi j'utilise ceci

Sub Départage()
'
' Mode SHARED "OFF" à l'ouverture
If ActiveWorkbook.MultiUserEditing Then
Application.DisplayAlerts = False ' Pas de message d'erreur
ActiveWorkbook.ExclusiveAccess ' Accès exclusif activé !
Application.DisplayAlerts = True
End If
End Sub
Sub Partarge()

'Sauvegarde en réactivant le partage !
If Not ActiveWorkbook.MultiUserEditing Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
Application.DisplayAlerts = True
End If
End Sub

Ça à l'air bien ça 😉
Après le bout de code dois agir a un moment donné est ce que si j'insere ceci cela va agir Que sur le fichie ouvert ? C'est en tout cas mon but
If ActiveWorkbook.MultiUserEditing Then
Application.DisplayAlerts = False ' Pas de message d'erreur
ActiveWorkbook.ExclusiveAccess ' Accès exclusif activé !
Application.DisplayAlerts = True
End If
End Sub