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
Et voici mon fichier:
(c) CJoint.com, 2012
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 SubEt voici mon fichier:
(c) CJoint.com, 2012
