Problème de protection lors de copie avec macro
Résolu/Fermé
bassmart
Messages postés
277
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
30 août 2022
-
9 avril 2015 à 18:44
bassmart Messages postés 277 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 30 août 2022 - 9 avril 2015 à 19:51
bassmart Messages postés 277 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 30 août 2022 - 9 avril 2015 à 19:51
A voir également:
- Problème de protection lors de copie avec macro
- Lien copie - Forum Android
- Macro logiciel - Télécharger - Organisation
- Copie cachée - Guide
- Lien copié - Forum Android
- Super copie - Télécharger - Gestion de fichiers
1 réponse
cs_Le Pivert
Messages postés
7883
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 mars 2023
724
9 avril 2015 à 18:58
9 avril 2015 à 18:58
Bonjour,
Voir ceci:
http://www.excelabo.net/excel/protection_multi_feuilles
Voir ceci:
http://www.excelabo.net/excel/protection_multi_feuilles
9 avril 2015 à 19:51
Voici mon code corrigé:
Private dlig As Long Private PL As Range Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim nvalue As String Dim NewVal As Variant Dim f As Worksheet Dim valueRange As Range Dim Cpt As Integer Dim nombre As Integer Dim i As Integer Application.ScreenUpdating = False nvalue = ActiveCell.Value If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _ vbYesNo + vbQuestion, "MODIFER") = vbYes Then NewVal = UCase(InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO")) If NewVal = "" Then ActiveCell.Offset(-1, 0).Select Exit Sub Else ActiveCell = NewVal End If If InStr(1, nvalue, "C") = 1 Or InStr(1, nvalue, "M") = 1 Then Set valueRange = Sheets("CPTU").Columns(1) ElseIf InStr(1, nvalue, "F") = 1 Then Set valueRange = Sheets("FORAGE").Columns(1) ElseIf InStr(1, nvalue, "Z") = 1 Or InStr(1, nvalue, "FZ") = 1 Then Set valueRange = Sheets("Piézomètres").Columns(2) ElseIf InStr(1, nvalue, "I") = 1 Then Set valueRange = Sheets("Inclinomètres").Columns(2) Else Set valueRange = Nothing MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical End If If Not valueRange Is Nothing Then nombre = ActiveWorkbook.Sheets.Count Application.ScreenUpdating = False For i = 1 To nombre Worksheets(i).Unprotect Next i valueRange.Replace nvalue, NewVal, lookat:=xlWhole, searchorder:=xlByColumns End If If NewVal <> nvalue Then MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT" ActiveCell.Offset(-1, 0).Select End If nombre = ActiveWorkbook.Sheets.Count Application.ScreenUpdating = False For i = 1 To nombre Worksheets(i).Protect Next i Else ActiveCell.Offset(-1, 0).Select End If End If Application.ScreenUpdating = True Application.EnableEvents = True End Sub