bonjour a tous
j'ai un gros probleme que je n'arrive pas a resoudre
suite a un poste sur ce forum :
https://www.excel-downloads.com/threads/fichier-multi-utilisateur-proteger.86697/
j'ai fait ce bout de code
normalement ca devrai marcher
mais il y a un plantage ici
pour passer le bug il suffit:
de retourner sur le classeur excel
de revenir a VB
de relancer et tout passe bien
ce code est lancer sous excel 2000 (pack office)
si quelqu'un peut m'aider ce serrai top car la je nage un peut
j'ai un gros probleme que je n'arrive pas a resoudre
suite a un poste sur ce forum :
https://www.excel-downloads.com/threads/fichier-multi-utilisateur-proteger.86697/
j'ai fait ce bout de code
Code:
Sub Debut_Reservation()
Dim Rep As String
Dim celx, cely As Integer
Dim Nom As String
Dim debut As Integer
Dim bit As Boolean
Dim ligne As Integer
If Sheets("reservation").Range("z100") <> "" Then Exit Sub
Rep = Application.InputBox("Veuillez entrer votre mot de passe", Title:="Réservation outillage", _
Type:=2, Default:=Application.UserName)
debut = 134
bit = False
While Sheets("data").Cells(debut + 1, 9).Value <> "" And bit = False
debut = debut + 1
If Rep = Sheets("data").Cells(debut, 9).Value Then bit = True
Wend
If bit = False Then
MsgBox "Password incorrecte"
Else:
MsgBox "Password correcte"
With Sheets("Reservation")
.Unprotect Password:="toto"
'.Activate
Sheets("reservation").Range("z100") = Sheets("data").Cells(debut, 10).Value
Nom = Sheets("reservation").Range("z100")
celx = 6
cely = 2
While .Cells(celx, cely).Value <> ""
While .Cells(celx, cely).Value <> ""
For ligne = 1 To 2
If (.Cells(celx + ligne, cely).Value = .Range("z100")) Or (.Cells(celx + ligne, cely).Value = "") Then
.Cells(celx + ligne, cely).Locked = False
.Cells(celx + ligne, cely).FormulaHidden = False
With .Cells(celx + ligne, cely).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=Nom
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
End If
Next
cely = cely + 1
Wend
cely = 2
celx = celx + 3
Wend
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
UserInterfaceOnly:=True, Password:="toto"
End With
End If
End Sub
mais il y a un plantage ici
un message d'erreur 1004.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=Nom
pour passer le bug il suffit:
de retourner sur le classeur excel
de revenir a VB
de relancer et tout passe bien
ce code est lancer sous excel 2000 (pack office)
si quelqu'un peut m'aider ce serrai top car la je nage un peut