Protection : classeur ouvrable sur deux ordinateurs seulement

Bonjour,
A partir de ces 2 scripts tirés du site de Frédéric Sigonneau, un peu
d'adaptation pour le mot de passe et "ça devrait le faire "......
Attribute VB_Name = "AdresseIPduPC"

Pounet95

---------- SCRIPTS Frédéric SIGONNEAU ----------
'renvoie l'adresse IP du PC (renvoi par défaut : 0.0.0.0)

Sub monIP()
'auteur inconnu

fichTmp$ = "C:windowstempIPaMoi.txt"
ID = Shell("C:windowswinipcfg /batch " & fichTmp, 1)
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fichTmp)
Set ts = f.OpenAsTextStream(1, 0)
For i = 1 To 6
S = ts.Readline
Next

ts.Close
Kill fichTmp
MsgBox S

End Sub

Sub test()
MsgBox AdrIP
End Sub

'la même chose, sous forme de fonction
Function AdrIP()
Dim fichTmp$, S$, ID&, fs As Object, f As Object, ts As Object

fichTmp$ = "C:windowstempIPaMoi.txt"
ID = Shell("C:windowswinipcfg /batch " & fichTmp, 1)
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fichTmp)
Set ts = f.OpenAsTextStream(1, 0)
For i = 1 To 6
S = ts.Readline
Next
ts.Close
Kill fichTmp

AdrIP = Trim(Mid(S, InStr(1, S, ":") + 1))

End Function 'fs

"Coriandre" <nospam-wattin@free.fr.invalid> a écrit dans le message de
news:uE1yTB0WIHA.1208@TK2MSFTNGP03.phx.gbl...

Bonjour,

Est-il possible de ne permettre l'ouverture d'un classeur Excel que sur
deux
ordinateurs précis (définis par leur ID ou celui de Windows ou ... ?) ?
L'utilisation sur un autre ordinateur serait possible mais demanderait
alors
l'entrée d'un mot de passe.

Il s'agit d'éviter d'avoir à entrer un mot de passe plusieurs fois par
jour
quand on utilise le classeur (ouvert et fermé de nombreuses fois par jour)
sur ses propres ordinateurs.

--
Coriandre

Salut voici de quoi faire avec le N° windows
Youky

Private Sub Workbook_Open()
Test
End Sub

'ensuite en module

Function NumSerieWin()
Dim Cle, WSH As Object
Cle = "HKLMSoftwareMicrosoftWindowsCurrentVersionProductID"
Set WSH = CreateObject("WScript.Shell")
NumSerieWin = WSH.regread(Cle)
End Function
Sub Test()
Exit Sub
Dim numOK As Boolean
If NumSerieWin = "52782-OEM-0070464-00000" Then numOK = True ' N°Bruno
If NumSerieWin = "52782-OEM-0007123-00000" Then numOK = True ' N°Yvan
If Not numOK Then
MsgBox "Autorisation refusée"
ActiveWorkbook.Close SaveChanges:úlse
End If
End Sub


"Coriandre" <nospam-wattin@free.fr.invalid> a écrit dans le message de news:
uE1yTB0WIHA.1208@TK2MSFTNGP03.phx.gbl...

Bonjour,

Est-il possible de ne permettre l'ouverture d'un classeur Excel que sur
deux
ordinateurs précis (définis par leur ID ou celui de Windows ou ... ?) ?
L'utilisation sur un autre ordinateur serait possible mais demanderait
alors
l'entrée d'un mot de passe.

Il s'agit d'éviter d'avoir à entrer un mot de passe plusieurs fois par
jour
quand on utilise le classeur (ouvert et fermé de nombreuses fois par jour)
sur ses propres ordinateurs.

--
Coriandre

Bonjour,

Private Sub Workbook_Open()
If UCase(Environ("username")) = "BOISGONTIER" Or
UCase(Environ("username")) = "DUPONT" Then
For s = 2 To Sheets.Count ' on demasque les feuilles
Sheets(s).Visible = True
Next s
Else
motpasse = InputBox("Mot de passe?")
If motpasse = "xxxx" Then
For s = 2 To Sheets.Count ' on demasque les feuilles
Sheets(s).Visible = True
Next s
Else
MsgBox "Erreur !"
End If
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
For s = 2 To Sheets.Count ' on masque les feuilles
Sheets(s).Visible = xlVeryHidden
Next s
End Sub

JB

Merci beaucoup de vos propositions.

J'ai mixé celles de Youky et JB pour les adapter à mes besoins.

A noter que pour un ordinateur sous Vista, la clé de registre à mettre dans
le code est :
HKLMSOFTWAREMicrosoftWindows NTCurrentVersionProductId
et celle sous Windows XP est :
HKLMSOFTWAREMicrosoftWindowsCurrentVersionProductId

Il y a peut-être plus simple, mais du coup, ayant des ordinateurs sous les
deux OS, j'ai créé 2 fonctions au lieu d'une.

A ce propos, faut-il absolument un module par fonction, ou peut-on regrouper
toutes les fonctions d'un classeur dans le même module ?

D'autre part, j'ai ôté le "exit sub" de début de macro de Youki :
--------------------
Sub Test()
Exit Sub
Dim numOK As Boolean
If NumSerieWin = "52782-OEM-0070464-00000" Then numOK = True ' N°Bruno
If NumSerieWin = "52782-OEM-0007123-00000" Then numOK = True ' N°Yvan
If Not numOK Then
MsgBox "Autorisation refusée"
ActiveWorkbook.Close SaveChanges:úlse
End If
End Sub
---------------------
qui bloquait l'interdiction sur les ordinateurs non autorisés, et ai modifié
certaines autres lignes en :
----------------------
Sub Test()
'1ère fonction
If NumSerieWinVista = "52782-OEM-0070464-00000" Then numOK = True ' N°Bruno
'2ème fonction
If NumSerieWinXP = "52782-OEM-0007123-00000" Then numOK = True ' N°Yvan
'Changement
If numOK = False Then
'On peut quand même ouvrir le classeur si on connaît le mot de passe
MotPasse = InputBox("Entrer le mot de passe")
If MotPasse = "mot de passe" Then
Exit Sub
Else
MsgBox "Autorisation refusée"
ActiveWorkbook.Close SaveChanges:úlse
End If
End If
---------------------------

--
Coriandre

--------------------------------------------
Aide de "Pounet95" <pounetchezlui@ouanadou> dans le message de
news:ud2W5X0WIHA.1132@TK2MSFTNGP06.phx.gbl...
Aide de "Youky" <nospam.bruno.jeune@wanadoo.fr> dans le message de
news:OJ$Lcb0WIHA.5448@TK2MSFTNGP04.phx.gbl...
Aide de "JB" <boisgontier@hotmail.com> dans le message de
news:9c7f8127-86f2-4df1-ab5b-3fd4411526d3@s13g2000prd.googlegroups.com...