Je sais qu'il s'agit d'un sujet traité des milliers de fois, mais j'aimerai mettre en place une manière d'assigné un classeur à un poste de travail. Adresse mac etc .. plusieurs façon sont présente sur internet mais beaucoup trop compliqué pour surtout quelque chose qu'il est possible de contourné.
Malgré tout, l'idée pour moi est de mettre un classeur xlsm sur 3 postes différents. Poste utiliser par des utilisateurs ou le facteur risque de contournement est casi-nul. Ces postes non-connecté à internet ne doivent pas pouvoir utiliser les 2 autres fichiers que celui qui lui ai assigné. Alors j'ai lu énormément de chose, j'ai vu qu'il été possible à l'ouverture du fichier de lire un .txt comportant une donnée et si le .txt ou la donnée ne sont pas présente bloquer l'utilisation. J'avais également eu l'idée du nom de la machine ? ou du compte de la session ? Chaque fichier comporte un onglet Param qui est visible. Voici un code que j'ai fais pour le moment avec le nom d'utilisateur mais sa me semble pas très bien
VB:
Private Sub Workbook_Open()
Sheets("Param").Select
Range("A28").Select
If Selection = "" Then
Code
End If
Code2
If Sheets("Param").Range("A27").Value = Sheets("Param").Range("A28").Value Then
Sheets("Param").Range("A27").Clear
Else
MsgBox "Pas le bon poste"
Application.Quit
End If
ActiveWorkbook.Save
End Sub
VB:
Sub Code()
Application.ScreenUpdating = False
Dim user As Variant
user = Environ("username")
Sheets("Params").Select
Range("A27").Select
ActiveCell = user
ThisWorkbook.Save
Sheets("Devis").Activate
Application.ScreenUpdating = True
End Sub
Sub Code2()
Application.ScreenUpdating = False
Dim user2 As Variant
user2 = Environ("username")
Sheets("Params").Select
Range("A28").Select
ActiveCell = user2
ThisWorkbook.Save
Sheets("Devis").Activate
Application.ScreenUpdating = True
End Sub
Si vous avez une idée ou des modification à suggerer je suis toute oui
Merci
Mais je trouve tes macros successives bien compliquées et tordues...
VB:
Option Explicit
Option Compare Text
Private Sub Workbook_Open()
Dim WS As Worksheet
Dim Cell As Range
Dim User As String
Dim UserOK As Boolean
User = Environ("Username")
For Each Cell In ThisWorkbook.Worksheets("PARAM").Range("A2:A5")
If User = Cell.Text Then
UserOK = True
End If
Next Cell
If UserOK = False Then
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "HOME" Then
WS.Visible = xlSheetVeryHidden
End If
Next WS
End If
End Sub
Ci-joint le classeur où il ne teste pas car je force au début :
UserOK = True '<<<<<<<<<<<<<<<<<< A ENLEVER !!!
Pourquoi leur mettre les 3 fichiers alors ?
Sinon plus simplement tu mets une protection classeur. Chacun ne pourra ouvrir que son classeur avec son mdp.
A condition d'avoir confiance en eux bien sûr
eric
Mais je trouve tes macros successives bien compliquées et tordues...
VB:
Option Explicit
Option Compare Text
Private Sub Workbook_Open()
Dim WS As Worksheet
Dim Cell As Range
Dim User As String
Dim UserOK As Boolean
User = Environ("Username")
For Each Cell In ThisWorkbook.Worksheets("PARAM").Range("A2:A5")
If User = Cell.Text Then
UserOK = True
End If
Next Cell
If UserOK = False Then
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "HOME" Then
WS.Visible = xlSheetVeryHidden
End If
Next WS
End If
End Sub
Ci-joint le classeur où il ne teste pas car je force au début :
UserOK = True '<<<<<<<<<<<<<<<<<< A ENLEVER !!!
Bonjour Thierry, merci beaucoup pour ta réponse c'est une excellente piste.
J'ai fais quelques tests et cela fonctionne. Seulement la problématique que je vais rencontré c'est qu'étant donné que chaque session portera le prénom de l'user il sera donc possible pour deux personnes du même prénom de s'échanger les fichiers.
Est-il possible de faire quelque chose de similaire avec le nom de machine et empêcher la modif de la cellule en question ? Ou même faire la verif d'une chaîne de caractère présente en dure dans le code VBA et dans une cellule ? Comparé les deux et empêcher l'utilisation si différent ? Ainsi en cas de modification de la chaîne de caractère par l'user fichier non utilisable. Et si l'idée lui vien de copier la chaîne d'un autre fichier idem
Pourquoi leur mettre les 3 fichiers alors ?
Sinon plus simplement tu mets une protection classeur. Chacun ne pourra ouvrir que son classeur avec son mdp.
A condition d'avoir confiance en eux bien sûr
eric
Je pense que je me suis mal exprimé, car chacun aura un fichier sur son poste. Seulement les ports usb étant dispo une copie est possible. Pour le mdp du classeur cela n'empechera pas les user de s'échanger les fichiers avec le mdp
si ils ne sont pas en réseau, tu pourrais te baser sur le n° du disque dur :
VB:
Sub numHD()
MsgBox HDserial("C:")
End Sub
Function HDserial(drvpath As String)
Dim fs, d
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
HDserial = d.SerialNumber
End Function
Pourquoi "Prénom" ? Environ$("USERNAME") retourne la String du Log-In name de Windows, normalement dans un réseau c'est unique sur l'AD. Maintenant si ce sont des PCs standalone, c'est idem ou bien ils se connectent tous en tant que "Guest" ou ils s'appellent tous Jean Dupont, et jamais Jean Dupond....
Et toujours il y aussi
MsgBox Environ$("COMPUTERNAME")
Qui te retournera le nom de la machine
Sinon la solution du numéro de série du disque dûr est aussi une piste comme proposé par Eric.