XL 2019 Assigné un classeur

Bilna

XLDnaute Nouveau
Bonsoir,

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
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir @Bilna , le forum

beaucoup trop compliqué pour surtout quelque chose qu'il est possible de contourné.

Comme tu dis !

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 !!!

Ce sera efficace tant que ...............

Bonne nuit
@+Thierry
 

Pièces jointes

  • XLD_Bilna_CacheCache_Feuilles.xlsm
    19.2 KB · Affichages: 6

eriiic

XLDnaute Barbatruc
Bonjour à tous,

Je dois avoir mal compris tes explications :
Ces postes non-connecté à internet ne doivent pas pouvoir utiliser les 2 autres fichiers que celui qui lui ai assigné.
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
 

Bilna

XLDnaute Nouveau
Bonsoir @Bilna , le forum



Comme tu dis !

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 !!!

Ce sera efficace tant que ...............

Bonne nuit
@+Thierry


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

Bonjour 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

Merci
 

eriiic

XLDnaute Barbatruc
Bonjour,

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
eric
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir @eriiiic , @Roblochon , @Bilna , le Forum

portera le prénom de l'user il sera donc possible pour deux personnes du même prénom de s'échanger les fichiers.

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.

NB Solution non valable sur Mac

Bonne soirée
@+Thierry
 

Discussions similaires