Erreur d'éxécution '13'

Résolu/Fermé
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 12 mars 2015 à 15:30
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 12 mars 2015 à 15:57
Bonjour à tous,

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

Merci pour votre aide!

A voir également:

1 réponse

f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
12 mars 2015 à 15:45
Bonjour,

Dim NewVal As Variant
0
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
12 mars 2015 à 15:57
Merci beaucoup pour la réponse f894009!

C'était mon problème! Là ça fonctionne très bien dans les 2 cas!

Encore merci!
0