Macro pour protection et effacer le contenu de cellules
EVKona
-
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
J'ai trouvé cette macro pour effacer le contenu d'un "Range" de cellules pour une feuille active et activer la protection, mais j'aimerais utiliser cette Macro sur différentes cellules de différentes Worksheet, idées?
Des que j'active cette macro, toutes les données dans les Range s'effacent mais les worksheet n'ont pas de protection activé sauf la première(24V Worksheet).
Voici la Macro:
Sub ClearcellsAsProtect()
Dim xWS As Worksheet
Dim xPsw As String
Set xWS = ActiveSheet
xPsw = "thisistheway"
On Error Resume Next
xWS.Unprotect Password:=xPsw
Range("'24V Worksheet'!C19:C20").ClearContents
Range("'24V Worksheet'!C23:C25").ClearContents
Range("'36V Worksheet'!C19:C20").ClearContents
Range("'36V Worksheet'!C23:C27").ClearContents
Range("'48V Worksheet'!C19:C23").ClearContents
Range("'48V Worksheet'!C26:C32").ClearContents
Range("'80V Worksheet'!C19:C22").ClearContents
Range("'80V Worksheet'!C25:C30").ClearContents
xWS.Protect Password:=xPsw
End Sub
J'ai trouvé cette macro pour effacer le contenu d'un "Range" de cellules pour une feuille active et activer la protection, mais j'aimerais utiliser cette Macro sur différentes cellules de différentes Worksheet, idées?
Des que j'active cette macro, toutes les données dans les Range s'effacent mais les worksheet n'ont pas de protection activé sauf la première(24V Worksheet).
Voici la Macro:
Sub ClearcellsAsProtect()
Dim xWS As Worksheet
Dim xPsw As String
Set xWS = ActiveSheet
xPsw = "thisistheway"
On Error Resume Next
xWS.Unprotect Password:=xPsw
Range("'24V Worksheet'!C19:C20").ClearContents
Range("'24V Worksheet'!C23:C25").ClearContents
Range("'36V Worksheet'!C19:C20").ClearContents
Range("'36V Worksheet'!C23:C27").ClearContents
Range("'48V Worksheet'!C19:C23").ClearContents
Range("'48V Worksheet'!C26:C32").ClearContents
Range("'80V Worksheet'!C19:C22").ClearContents
Range("'80V Worksheet'!C25:C30").ClearContents
xWS.Protect Password:=xPsw
End Sub
A voir également:
- Macro pour protection et effacer le contenu de cellules
- Fusionner deux cellules excel en gardant le contenu - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Formule excel pour additionner plusieurs cellules - Guide
- K9 web protection - Télécharger - Contrôle parental
- Effacer les données de navigation sur android - Guide
2 réponses
Bonjour,
faire une boucle sur toutes les feuilles comme ceci:
faire une boucle sur toutes les feuilles comme ceci:
Sub protection()
'Déclare la variable objet Worksheet
Dim Ws As Worksheet
'Boucle sur toutes les feuille de calcul du classeur. Les onglets graphiques ne sont pas pris
'en compte.
'ThisWorkbook correspond à l'objet classeur contenant la macro
For Each Ws In ThisWorkbook.Worksheets
Ws.Protect Password:="thisistheway"
Next Ws
End Sub
Sub deprotection()
'Déclare la variable objet Worksheet
Dim Ws As Worksheet
'Boucle sur toutes les feuille de calcul du classeur. Les onglets graphiques ne sont pas pris
'en compte.
'ThisWorkbook correspond à l'objet classeur contenant la macro
For Each Ws In ThisWorkbook.Worksheets
Ws.Unprotect Password:="thisistheway"
Next Ws
End Sub
Bonjour,
Au passage , pour tenir compte des plages différentes dans chaque feuille:
Au passage , pour tenir compte des plages différentes dans chaque feuille:
Sub ClearcellsAsProtect()
Dim xPsw As String
xPsw = "thisistheway"
Sheets("'24V Worksheet'").Unprotect Password:=xPsw
Range("'24V Worksheet'!C19:C20:C23:C25").ClearContents
Sheets("'24V Worksheet'").Protect Password:=xPsw
Sheets("'36V Worksheet'").Unprotect Password:=xPsw
Range("'36V Worksheet'!C19:C20:C23:C27").ClearContents
Sheets("'36V Worksheet'").Protect Password:=xPsw
Sheets("'48V Worksheet'").Unprotect Password:=xPsw
Range("'48V Worksheet'!C19:C23:C26:C32").ClearContents
Sheets("'48V Worksheet'").Protect Password:=xPsw
Sheets("'80V Worksheet'").Unprotect Password:=xPsw
Range("'80V Worksheet'!C19:C22:C25:C30").ClearContents
Sheets("'80V Worksheet'").Protect Password:=xPsw
End Su