La macro qui s'effectue une fois correctement, après plus rien!!

bassmart

XLDnaute Nouveau
Bonjours à tous!

J'ai un problème avec mon fichier qui contient plusieurs macro. J'ai une macro qui s'active quand l'on double clic (Worksheet_BeforeDoubleClic) dans la colonne C de la feuille Coordonnées, pour modifier la valeur de cette cellule. J'ai une autre macro qui met les toutes entrées sur cette feuille en majuscule (UCase) aussi.

Elle s'effectue très bien la première fois, mais lorsque je veux modifier une autre valeur en double cliquant dans la colonne, plus rien ne se passe et même que l'autres macros se retrouvant sur cette feuille ne fonctionne plus non plus.

Qu'est-ce passe t'il?

Que puis-je faire pour corriger la situation?

Merci pour d'avance pour votre aide!

Voici les macro qui se retrouve directement sur ma feuille "Coordonnées

Code:
Private dlig As Long
Private PL As Range
Public var As Variant
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nValue As String
Dim NewVal As String
Dim f As Worksheet
Dim sheetName As String


Application.ScreenUpdating = False

For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next

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$(Application.InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO", Type:=2))
            ActiveCell = NewVal
            
            
            
      
            If InStr(1, nValue, "C") = 1 Or InStr(1, nValue, "M") = 1 Then
                sheetName = "CPTU"
            ElseIf InStr(1, nValue, "F") = 1 Then
                sheetName = "FORAGE"
            ElseIf InStr(1, nValue, "Z") = 1 Or InStr(1, nValue, "FZ") = 1 Then
                sheetName = "Piézomètres"
               
            ElseIf InStr(1, nValue, "I") = 1 Then
                sheetName = "Inclinomètres"
                
            Else
                sheetName = ""
                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 Len(sheetName) > 0 Then
                Sheets(sheetName).Columns(1).Replace nValue, NewVal, LookAt:=xlWhole, SearchOrder:=xlByColumns
                End If
            
                
                                   
     
        If var <> Target Then
        var = Target.Value
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
    
        End If
        
    Else
    
    ActiveCell.Select
    
    End If
    
End If

For Each f In ActiveWorkbook.Worksheets
            f.Protect
        Next

Application.ScreenUpdating = True

ActiveCell.Offset(-1, 0).Select 'Range("B5").Select
 
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect

If Target.Column >= 3 And Target.Column <= 5 Then
        'desactive les evenements excel: eviter appel recurcif a la suite du passage en majuscule
        Application.EnableEvents = False
        Target = UCase(Target)
    End If
    'active les evenements excel
    Application.EnableEvents = True


If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 5 Or Target.Column <> 5 Then Exit Sub
If Target.Value = "" Then Cells(Target.Row, 1).ClearContents
If Range("A5") <> "" Then
    dlig = Range("E5").End(xlDown).Row
    Set PL = Range("A5:A" & dlig)
    PL.Value = Range("a5").Value
   
End If


Dim T As Range, i&
Set T = [TableauCoord]
Application.EnableEvents = False
On Error Resume Next 'sécurité
If T.Rows.Count < 4 Then
  Application.Undo 'annulation
Else
  '---suppression des lignes vides---
  For i = T.Rows.Count - 1 To 4 Step -1
    If T(i, 1) = "" Then T(i, 1).EntireRow.Delete
  Next
  '---ajout de ligne---
  If T(T.Rows.Count, 1) <> "" Then
    Application.ScreenUpdating = False
    T(T.Rows.Count, 1).EntireRow.Insert
    T.Rows(T.Rows.Count - 1).FormulaR1C1 = T.Rows(T.Rows.Count).FormulaR1C1
    T.Rows(T.Rows.Count) = ""
    Application.ScreenUpdating = True
  End If
End If

Application.EnableEvents = True

ActiveSheet.Protect

End Sub

Private Sub worksheet_activate()
   
Dim resultat As String
Const Dossier As String = "6.02.06.MT.02."

ActiveSheet.Unprotect
If Range("a5") = 0 Then
    resultat = UCase(InputBox("Entrez le numéro du Bassin Versant!", "Bassin Versant"))
    If resultat <> "" Then
        dlig = Range("E5").End(xlDown).Row
        Set PL = Range("A5:A" & dlig)
        PL.Value = Dossier & resultat
    End If
    
End If

ActiveSheet.Protect
Range("b5").Select


End Sub

Et voici mon fichier:

(c) CJoint.com, 2012
 
C

Compte Supprimé 979

Guest
Re : La macro qui s'effectue une fois correctement, après plus rien!!

Bonjour Bassmart

Ton problème vient du
Code:
Application.EnableEvents = False
dans la sub :
Code:
Worksheet_Change(ByVal Target As Range)
qui n'a pas de retour à la normale dans tes différentes feuilles

A+
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 783
Membres
101 817
dernier inscrit
carvajal