Besoin d'aide ici! J'ai un code qui fais appel à un InputBox(type 2) qui marchais bien sauf lorsque j'appuyais sur ANNULÉ. Avec l'aide d'une personne sur le forum, mon problème à été réglé, mais là le reste de ma macro ne fonctionne plus code d'erreur '13' sur la ligne
If NewVal = False Then
qui fait en sorte qu'il sort de l'InputBOx et de la macro si j'appui sur annulé.
J'ai lancé des espion sur les valeurs NewVal et nValue et tout est ok!
Voici mon code complet:
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 String
Dim f As Worksheet
Dim valueRange As Range
Dim Cpt As Integer
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))
If NewVal = False 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
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
Else
ActiveCell.Offset(-1, 0).Select
End If
End If
For Each f In ActiveWorkbook.Worksheets
f.Protect
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
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
'AJOUT DE LIGNE À LA FIN DE MON TABLEAU
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
Dim Valeur As String
Dim plage, Cellule As Range
' Ici spécifier la plage à couvrir !
Set plage = Range("N5:N" & dlig)
For Each Cellule In plage
Valeur = Mid(Cellule.Value, 2)
Valeur = UCase(Mid(Cellule.Value, 1, 1)) & Valeur
Cellule.Value = Valeur
Next Cellule
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
C'était mon problème! Là ça fonctionne très bien dans les 2 cas!
Encore merci!