Discussion :

[dlight]

Bonjour à tous.

Un des mes collègue a préparé un fichier dans lequel il y a le code suivant...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo CaMarchePas
 
Dim Question1D As Integer, Question1F As Integer, PW As String, x As String, y As String
 
If Target(1, 1).Column = 6 And Target(1, 1).Row = 9 And Target.Value = "x" Then
 
Rows(Question1D & ":" & Question1F).Select
    Selection.EntireRow.Hidden = True
 
End If
 
If Target(1, 1).Column = 6 And Target(1, 1).Row = 9 And Target.Value <> "x" Then
 
Rows(Question1D & ":" & Question1F).Select
    Selection.EntireRow.Hidden = False
 
End If

Il fait appel à moi pour l'aider suite à l'erreur 13. La situation se produit dès que plus d'une cellules sont sélectionnées et que l'on supprime le contenu.

Existe-t-il une solution pour contourner ce problème.

Merci à l'avance pour vos pistes de solutions.

Dlight

[casefayere]

bonjour,
essayes ce code non testé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Question1D As Integer, Question1F As Integer, PW As String, x As String, y As String
 
If Target.Column = 6 And Target.Row = 9 And Selection.Rows.Count = 1 Then
  If Target.Value = "x" Then
    Rows(Question1D & ":" & Question1F).EntireRow.Hidden = True
  Else
    Rows(Question1D & ":" & Question1F).EntireRow.Hidden = False
  End If
End If
End Sub

[EngueEngue]

Remplace:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

On Error GoTo CaMarchePas

Par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

On Error Resume Next

[dlight]

Merci à vous deux pour votre aide.

Le code proposé par casefayere donne l'erreur 13 simplement en exécutant l'action de masquer en sélectionnant la cellule en question.

J'ai omis de vous dire qu'il y a quelques cellules à cocher qui feront la même action mais sur d'autres lignes. Le "resume next" démasque les autres lignes.

Une fois de plus merci pour votre aide

Dlight

[casefayere]

je n'ai pas fait gaffe mais ou sont les valeurs des variables dans

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
...
 Rows(Question1D & ":" & Question1F)...

Question1D = quoi
Question1F= quoi

[dlight]

Les informations se trouve dans une feuille. Puisque ce fichier sera sujet à modification dans le futur (ajout de questions dans cette section), je lui ai demandé d'inscrire les lignes de départ et de fin et des les récupérer dans le code.

Question1D = [QI_Q1D] = 10
Question1F = [QI_Q1F] = 13

Merci

Dlight

[leloutre38]

Salut
Si [QI_Q1D] et [QI_Q1F] sont des cellules nommées tu peux récupérer leurs valeurs.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Question1D = Names("QI_Q1D").RefersToRange
Question1F = Names("QI_Q1F").RefersToRange

Aussi pour éviter les erreurs en cas d'une fauts de frappe dans les cellules tu peux utiliser la fonction isNumeric("") dans un if

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
If IsNumeric(Names("QI_Q1D").RefersToRange) Then
    Question1D = Names("QI_Q1D").RefersToRange
Else
    MsgBox " Votre cellule n'est pas numeric"
end if

avec le code de casefayere

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Question1D As Integer, Question1F As Integer, PW As String, x As String, y As String
If IsNumeric(Names("QI_Q1D").RefersToRange) and IsNumeric(Names("QI_Q1F").RefersToRange) Then
  Question1D = Names("QI_Q1D").RefersToRange
  Question1F = Names("QI_Q1F").RefersToRange
 
  If Target.Address = "$F$9" And Selection.Rows.Count = 1 Then
    If Target.Value = "x" Then
      Rows(Question1D & ":" & Question1F).EntireRow.Hidden = True
    Else
      Rows(Question1D & ":" & Question1F).EntireRow.Hidden = False
    End If
  End If
Else
 MsgBox " la cellule QI_Q1D ou QI_Q1F n'est pas numeric " 
End if
End Sub

bonne soirée