Cellules protégées

Le
charles.schauss
Bonjour,

J'espre que vous allez pouvoir m'aider.

J'ai cr une petite application Excel qui permet aux utilisateurs de s=
lectionner via une Liste de choix dans un formulaire VBA, un formulaire =
fiscal (classeur modle Excel) et d'y insrer les donnes de leur cli=
ent depuis une table Access.
Code VBA pour l'ouverture du formulaire
Private Sub lstbChoix_Click()
Dim strDoc as string

If Dir(lstbChoix.List(lstbChoix.ListIndex, 2)) = "" Then
MsgBox Prompt:="Ce document n'est pas install" , Buttons:=vbInfo=
rmation + vbOKOnly
Else
strDoc = lstbChoix.List(lstbChoix.ListIndex, 2)
Unload Me
Workbooks.Add Template:=strDoc
End If
End Sub

A l'ouverture du nouveau fichier, une macro (Workbook_Open) pour activer le=
formulaire de slection du client et puis insertion des donnes signal=
tiques sur la feuille active.

Le problme suivant apparait ensuite, mais seulement chez quelques utilis=
ateurs, heureusement;
Lorsqu'ils veulent saisir les montants dans le formulaire fiscal, ils re=
oivent le message que la cellule est protge, s'il veulent dprot=
ger la feuille, un mot de passe est demand alors que les feuilles sont p=
rotges sans mot de passe.
Or, en vrifiant, les feuilles du classeur sont protges, mais les c=
ellules en question sont bien dverrouilles.
Le phnomne est comme si plusieurs feuilles seraient slectionnes=
, car si je slectionne la seconde feuille de ce classeur et reviens ensu=
ite sur la premier, tout rentre dans l'ordre.

Excusez-moi pour ce long texte

D'avance merci pour votre aide
Charles
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #26339466
bonjour Charles,

peut tu montrer la macro Workbook_Open ?

isabelle
charles.schauss
Le #26339694
Le mardi 17 février 2015 00:09:18 UTC+1, isabelle a écrit :
bonjour Charles,

peut tu montrer la macro Workbook_Open ?

isabelle



Bonsoir Isabelle,

Bien sûr...
C'est la même depuis plusieurs années

Option Explicit

Private Sub Workbook_Open()
Dim FileNum As Integer
Dim vIntitulé As String, vValeur As Variant
Dim LDate As Date, LUserKey As String, LLicence As String
Dim HDSerial As Variant
Dim NomDoc As String
Dim objWorksheet As Worksheet


NomDoc = ActiveWorkbook.Name
FileNum = FreeFile
If GetSetting(AppName:="XLFisc", Section:="Licence", Key:="LicNum ber") = "" Then
MsgBox "Désolé. Veuillez faire appel à Mr Charles Schauss" & vbLf & "au 27 62 03 93, ou GSM: 621 268 158" _
& vbLf & "pour vérifier votre installation!", 48, "Avertissem ent"
Workbooks(NomDoc).Close SaveChanges:lse
Else
LUserKey = GetSetting(AppName:="XLFisc", Section:="Licence", Key:="UserKey")
LDate = GetSetting(AppName:="XLFisc", Section:="Licence", Key :="LicDate")
LLicence = GetSetting(AppName:="XLFisc", Section:="Licence", Key:="LicNumber")

HDSerial = Serial("C")

'Variable de calcul
Dim vJour As Integer, vMois As Integer, vAn As Integer
Dim vDate As Double
Dim xSerial As Variant

vJour = Day(LDate)
vMois = Month(LDate)
vAn = Year(LDate)
vDate = DateSerial(vAn, vMois, vJour)
xSerial = CStr(Val("&O" & LLicence) - ((vDate * vJour * vMois) - vAn))
If xSerial <> HDSerial Then
MsgBox "Désolé. Veuillez faire appel à Mr Charles Schauss " & vbLf & "au 27 62 03 93, ou GSM: 621 268 158" _
& vbLf & "pour vérifier votre installation ou enregistrer votre licence!", 48, "Avertissement"
Workbooks(NomDoc).Close SaveChanges:lse
Else
'Vérification si l'application est ouverte
If MAPPEOFFEN("XLFisc 2001.xls") And Sheets("Page1").Range("c_D esignation") = "" Then
On Error Resume Next
Sheets("Avis").Unprotect Password:Crypt(GetSetting("XL Fisc", "Parameter", "TemplPW"))
If Sheets("Avis").Range("C3") = "" Then
Sheets("Avis").Range("C3") = GetSetting(AppName:="X LFisc", Section:="Personnel", Key:="UserName")
Sheets("Avis").Range("C4") = GetSetting(AppName:="X LFisc", Section:="Personnel", Key:="UserAdresse") & _
IIf(GetSetting(AppName:="XLFisc", Section :="Personnel", Key:="UserAdresseNr") <> "", ", ", "") & _
GetSetting(AppName:="XLFisc", Section:= "Personnel", Key:="UserAdresseNr")
Sheets("Avis").Range("C5") = GetSetting(AppName:="X LFisc", Section:="Personnel", Key:="UserLand") & _
"-" & GetSetting(AppName:="XLFisc", Secti on:="Personnel", Key:="UserPostalCode") & _
" " & GetSetting(AppName:="XLFisc", Secti on:="Personnel", Key:="UserVille")
Sheets("Avis").Range("E6") = GetSetting(AppName:="X LFisc", Section:="Personnel", Key:="UserPhone")
Sheets("Avis").Range("E7") = GetSetting(AppName:="X LFisc", Section:="eTVA", Key:="Fax")
End If
Sheets("Avis").Protect Password:Crypt(GetSetting("XLFi sc", "Parameter", "TemplPW")), DrawingObjects:=True, Contents:=True, Sc enarios:=True
Application.Run "'XLFisc 2001.xls'!DoeTVA"
End If
End If
End If
End Sub

Même les fichiers des années précédentes ont le même soucis

Merci pour votre aide
Publicité
Poster une réponse
Anonyme