Protection feuille Excel + Macro
Bonjour à tous,
Je vous contacte car j'ai un problème au niveau d'un fichier Excel avec Macro.
J'ai une macro dans mon onglet "pre-selection tool" qui me permet de trouver rapidement les produits qui correspondent en fonction de différents critères en appuyant sur le bouton "Sort"
Mais ma macro va chercher les données dans l'onglet "WTG database" qui est une feuille protégée. Et je n'arrive pas à faire tourner ma macro si la feuille est protégée. Avez vous des solutions ?
Merci d'avance
Paul
Sub MacroUnprotect()
Sheets("WTG database").Select
ActiveSheet.Unprotect
End Sub
Sub CommandButton1_Click()
'VBA Variables initialization
Dim premiereCellule As Range
Dim colonne As Integer
Set premiereCellule = Sheets("WTG Database").Range("A2").CurrentRegion.Cells(1)
'--------------------------------------------Nominal Power-------------------------------------------------
Dim a As Variant
Dim b As Variant
a = Sheets("Pre-selection tool").Range("B3")
b = Sheets("Pre-selection tool").Range("B4")
colonne = Sheets("WTG Database").Range("D3").Column - premiereCellule.Column + 1
If VarType(a) = 0 And VarType(b) <> 0 Then
' Application du filtre pour valeurs inférieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:="<=" & b
End If
If VarType(a) <> 0 And VarType(b) = 0 Then
' Application du filtre pour valeurs supérieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & a
End If
If VarType(a) <> 0 And VarType(b) <> 0 Then
' Application du filtre pour valeurs entre ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & a, Operator:=xlAnd, Criteria2:="<=" & b
End If
'---------------------------------------------Rotor Diameter------------------------------------------------
Dim c, d
c = Sheets("Pre-selection tool").Range("E3")
d = Sheets("Pre-selection tool").Range("E4")
colonne = Sheets("WTG Database").Range("E3").Column - premiereCellule.Column + 1
If VarType(c) = 0 And VarType(d) <> 0 Then
' Application du filtre pour valeurs inférieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:="<=" & d
End If
If VarType(c) <> 0 And VarType(d) = 0 Then
' Application du filtre pour valeurs supérieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & c
End If
If VarType(c) <> 0 And VarType(d) <> 0 Then
' Application du filtre pour valeurs entre ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & c, Operator:=xlAnd, Criteria2:="<=" & d
End If
'---------------------------------------------------Hub Height----------------------------------------------
Dim e, f
e = Sheets("Pre-selection tool").Range("H3")
f = Sheets("Pre-selection tool").Range("H4")
colonne = Sheets("WTG Database").Range("G3").Column - premiereCellule.Column + 1
If VarType(e) = 0 And VarType(f) <> 0 Then
' Application du filtre pour valeurs inférieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:="<=" & f
End If
If VarType(e) <> 0 And VarType(f) = 0 Then
' Application du filtre pour valeurs supérieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & e
End If
If VarType(e) <> 0 And VarType(f) <> 0 Then
' Application du filtre pour valeurs entre ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & e, Operator:=xlAnd, Criteria2:="<=" & f
End If
'----------------------------------------------Tip Height--------------------------------------------------
Dim g, h
g = Sheets("Pre-selection tool").Range("K3")
h = Sheets("Pre-selection tool").Range("K4")
colonne = Sheets("WTG Database").Range("H3").Column - premiereCellule.Column + 1
If VarType(g) = 0 And VarType(h) <> 0 Then
' Application du filtre pour valeurs inférieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:="<=" & h
End If
If VarType(g) <> 0 And VarType(h) = 0 Then
' Application du filtre pour valeurs supérieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & g
End If
If VarType(g) <> 0 And VarType(h) <> 0 Then
' Application du filtre pour valeurs entre ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & g, Operator:=xlAnd, Criteria2:="<=" & h
End If
'Rotor bottom
Dim i
i = Sheets("Pre-selection tool").Range("N3")
colonne = Sheets("WTG Database").Range("I3").Column - premiereCellule.Column + 1
If VarType(i) <> 0 Then
' Application du filtre pour valeurs inférieures ou égales
premiereCellule.AutoFilter field:=colonne, Criteria1:=">=" & i
End If
'-------------------------------------------------IEC Wind Class--------------------------------------------
Dim j
j = Sheets("Pre-selection tool").Range("R2")
colonne = Sheets("WTG Database").Range("J3").Column - premiereCellule.Column + 1
If j = "I" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:=Array("I", "I-T", "S (Based on I)", "S (Based on I)-T", "DiBT", "TBC", "S"), Operator:=xlFilterValues
End If
If j = "II" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:=Array("II", "II-T", "S (Based on II)", "DiBT (based on II)", "DiBT", "TBC", "S"), Operator:=xlFilterValues
End If
If j = "III" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:=Array("III", "S (Based on III)", "DiBT (based on III)", "DiBT", "TBC", "S"), Operator:=xlFilterValues
End If
If j = "No specific IEC Wind Class" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:="*"
End If
'------------------------------------------------IEC Turbulence Class----------------------------------------
'List IEC Turbulence Class
Dim k
k = Sheets("Pre-selection tool").Range("R4")
colonne = Sheets("WTG Database").Range("K3").Column - premiereCellule.Column + 1
If k = "A" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:=Array("A", "S (based on A)", "DiBT", "TBC", "S"), Operator:=xlFilterValues
End If
If k = "B" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:=Array("B", "S (based on B)", "DiBT (Based on B)", "DiBT", "TBC", "S"), Operator:=xlFilterValues
End If
If k = "C" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:=Array("C", "S (based on C)", "DiBT", "TBC", "S"), Operator:=xlFilterValues
End If
If k = "No specific IEC Turbulence Class" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne, Criteria1:="*"
End If
'-----------------------------------------------Delivery Year------------------------------------------------
Dim l
l = Sheets("Pre-selection tool").Range("V4")
colonne = Sheets("WTG Database").Range("Q3").Column - premiereCellule.Column + 1
If l <> "" Then
' Application du filtre
premiereCellule.AutoFilter field:=colonne + 52, Criteria1:=">=" & l, Operator:=xlOr, Criteria2:="N/A"
premiereCellule.AutoFilter field:=colonne + 51, Criteria1:="<=" & l, Operator:=xlOr, Criteria2:="N/A"
premiereCellule.AutoFilter field:=colonne, Criteria1:=Array("In production", "In development", "Phasing Out"), Operator:=xlFilterValues
End If
'--------------------------------------------EDF R Qualification----------------------------------------------
Dim m
m = Sheets("Pre-selection tool").Range("V2")
colonne = Sheets("WTG Database").Range("T3").Column - premiereCellule.Column + 1
If VarType(m) <> 0 And m = "Yes" Then
' Application du filtre pour valeurs correspondantes
premiereCellule.AutoFilter field:=colonne, Criteria1:="Yes", Operator:=xlOr, Criteria2:="Design Checked"
End If
If VarType(m) <> 0 And m = "No" Then
' Application du filtre pour valeurs correspondantes
premiereCellule.AutoFilter field:=colonne, Criteria1:="No", Operator:=xlOr, Criteria2:="Step 1"
End If
'Copy Paste Filtered Table
Worksheets("WTG Database").Range("A3").CurrentRegion.Offset(1, 0).Copy _
Destination:=Worksheets("Pre-selection tool").Range("A6")
If Worksheets("WTG database").FilterMode Then Worksheets("WTG database").ShowAllData
End Sub
Private Sub CommandButton2_Click()
Worksheets("Pre-selection tool").Range("B3,B4,E3,E4,H3,H4,K3,K4,N3,R2,R4,V2,V4").Select
Selection.ClearContents
Worksheets("Pre-selection tool").Range("A6").CurrentRegion.Clear
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Sub MacroProtect()
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub
Pour info je vous mets ci-joint la macro.
J'ai rajouté en rouge le code pour d'abord dévérouiller et ensuite déverouiller, mais il ne fonctionne pas et m'affiche une erreur 400
Merci !
Bonjour, A tester toi même puisque tu n'as pas joins ton fichier
En dessous de : 'VBA Variables initialization
tu mets Sheets("WTG database".Unprotect
Endessous de :If Worksheets("WTG database").FilterMode Then Worksheets("WTG database").ShowAllData
tu mets Sheets("WTG database".Protect
Et tu supprimes les 2 macros en rouge
Cordialement
ça fonctionne !
Merci beaucoup !!
Autre question, au moment de demander à la Macro de Unprotect, est-ce que c'est possible de lui demander de taper le mot de passe à notre place ?
Bonjour
Après Unprotect et Protect tu ajoutes "ton mot de passe" ,n'oublie pas les 2 "" et tu enregistres
Crdlt
Si cela te convient tu passes le sujet en résolu