[XL-2010] ActiveSheet.Protect VBA ne fonctionne plus sous XL2010 [Résolu]

[lafafmentvotre]

Bonjour

J'ai un code qui ne passe plus depuis mon passage sous Excel2010.
Le verrouillage fonctionne, le déverrouillage aussi mais lorsque je verrouille de nouveau j'ai une erreur :


Je ne vois pas où cela plante.

Pourriez-vous m'aider ?

Merci

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Sub verrouiller()
On Error GoTo 1:
ActiveSheet.ShowAllData
1:
Range("L:L,O:O").Select
Selection.Copy
 
Columns("IU:IU").Select
ActiveSheet.Paste
 
Columns("IU:IU").Replace What:=".", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("L1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[243])"
Range("K1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection = "Sous Total"
Columns("IV:IV").Replace What:=".", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("O1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[241])"
 
 
Range("N1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection = "Sous Total"
 
 
Cells.Select
Selection.AutoFilter
 
If ActiveSheet.AutoFilterMode Then
Else
Selection.AutoFilter
End If
 
 
 
Selection.AutoFilter Field:=15, Criteria1:="<>"
 
Rows("1:1").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
 
 
Columns("B:B").Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("B1").Select
ActiveSheet.Protect Password:="PASSWORD", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
ActiveSheet.EnableSelection = xlUnlockedCells
MsgBox "Le fichier 'outgoing invoice' est Vérouillé", vbInformation, "Confirmation"
 
End Sub
 
 
Sub dévérouiller()
ActiveSheet.Unprotect Password:="PASSWORD"
 
On Error GoTo fin:
ActiveSheet.ShowAllData
fin:
 
Rows("65536:65536").Select
Selection.ClearContents
Columns("IU:IV").Select
Selection.ClearContents
 
Rows("1:1").Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
Columns("B:B").Select
Selection.Locked = True
Selection.FormulaHidden = False
 
Range("B1").Select
ActiveCell.FormulaR1C1 = "INVOICE_NR"
 
MsgBox "Le fichier 'outgoing invoice' est Dévérouillé", vbInformation, "Confirmation"
End Sub

[mercatog]

Bonjour
Déjà tu travailles avec toutes les cellules, alors que tu n'en a pas besoin
Évite en plus les Select

To code aurait l'allure comme ceci

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Verrouiller()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
    If .FilterMode Then .ShowAllData
    With .UsedRange
        .Range("L:L,O:O").Copy Range("IU1")
        .Range("IU:IV").Replace What:=".", Replacement:="."
        With .Cells(ActiveSheet.Rows.Count, "L").End(xlUp)
            .FormulaR1C1 = "=SUBTOTAL(9,C[243])"
            .Offset(0, -1) = "Sous Total"
        End With
        With .Cells(ActiveSheet.Rows.Count, "O").End(xlUp)
            .FormulaR1C1 = "=SUBTOTAL(9,C[241])"
            .Offset(0, -1) = "Sous Total"
        End With
        .AutoFilter Field:=15, Criteria1:="<>"
        .Rows("1:1").Interior.ColorIndex = 36
        With .Range("B:B")
            .Locked = False
            .FormulaHidden = False
        End With
    End With
    .Protect Userinterfaceonly:=True ',Password:="PASSWORD"
    .EnableSelection = xlUnlockedCells
End With
MsgBox "Le fichier 'outgoing invoice' est Vérouillé", vbInformation, "Confirmation"
Application.Calculation = xlCalculationAutomatic
End Sub

[lafafmentvotre]

C'est beaucoup mieux oui

Mais mon sous-total ne se met pas en dernière ligne mais dans le tableau (je joins le fichier)

Et pour déverrouiller ?

[mercatog]

En effet, Change comme ceci (lignes 10 et 14)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Verrouiller()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
    .Unprotect Password:="PASSWORD"
    If .FilterMode Then .ShowAllData
    With .UsedRange
        .Range("L:L,O:O").Copy Range("IU1")
        .Range("IU:IV").Replace What:=".", Replacement:=".", LookAt:=xlPart
        With .Cells(ActiveSheet.Rows.Count, "L").End(xlUp)(2)
            .FormulaR1C1 = "=SUBTOTAL(9,C[243])"
            .Offset(0, -1) = "Sous Total"
        End With
        With .Cells(ActiveSheet.Rows.Count, "O").End(xlUp)(2)
            .FormulaR1C1 = "=SUBTOTAL(9,C[241])"
            .Offset(0, -1) = "Sous Total"
        End With
        .AutoFilter Field:=15, Criteria1:="<>"
        .Rows("1:1").Interior.ColorIndex = 36
        With .Range("B:B")
            .Locked = False
            .FormulaHidden = False
        End With
    End With
    .Protect Userinterfaceonly:=True, Password:="PASSWORD"
    .EnableSelection = xlUnlockedCells
End With
MsgBox "Le fichier 'outgoing invoice' est Vérouillé", vbInformation, "Confirmation"
Application.Calculation = xlCalculationAutomatic
End Sub

PS:

Code :

.Protect Userinterfaceonly:=True, Password:="PASSWORD

Permet de protéger la feuille en laissant les modifications par macro.

[lafafmentvotre]

Génial

Et pour déverrouiller ?

[mercatog]

Bah qui sait conduire une R4, saura conduire une R12

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Dévérouiller()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet
    .Unprotect Password:="PASSWORD"
    If .FilterMode Then .ShowAllData
    With .UsedRange
        .Rows(.Rows.Count).ClearContents                   
        .Range("IU:IV").ClearContents
        .Rows(1).Interior.ColorIndex = 35
        With .Range("B:B")
            .Locked = True
            .FormulaHidden = False
        End With
        .Range("B1") = "INVOICE_NR"
    End With
End With
MsgBox "Le fichier 'outgoing invoice' est Dévérouillé", vbInformation, "Confirmation"
Application.Calculation = xlCalculationAutomatic
End Sub

[lafafmentvotre]

Excellent, merci beaucoup.

Je vais reprendre le tout pour bien comprendre et surtout apprendre.

Merci

[lafafmentvotre]

Bonjour

J'ai un soucis car les filtres sous 2010 sont bloqués lorsque j'exécute la macro "Verrouiller".

Est-il possible de verrouiller mais pas les filtres ?

Merci par avance pour votre aide

[Ormonth]

Bonjour,

vois les différents paramètres de la méthode Protect ici : http://silkyroad.developpez.com/VBA/...lcul/#LII-B-15

cordialement,

Didier

[lafafmentvotre]

Vu, merci