chaelie2015
XLDnaute Accro
Bonjour forum
JE souhaite réduire le code suivant :
Est-ce faisable ?
Merci
JE souhaite réduire le code suivant :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim numLignes As Integer
Dim rng As Range
Application.ScreenUpdating = False
Call AfficherOuMasquerIndice
Call AfficherOuMasquerIndice2
' Déterminer la feuille de travail
Set ws = ThisWorkbook.Sheets("Feuille de formulaire")
' Vérifier si la modification a eu lieu dans la cellule U11
If Not Intersect(Target, Me.Range("U11")) Is Nothing Then
numLignes = Me.Range("U11").Value
' Vérifier si le nombre de lignes est valide (entre 1 et 50)
If numLignes >= 0 And numLignes <= 50 Then
' Afficher les lignes correspondantes pour la plage 13:62
For Each rng In ws.Rows("13:62")
If rng.Row <= 12 + numLignes Then
rng.Hidden = False
Else
rng.Hidden = True
End If
Next rng
Else
MsgBox "Veuillez saisir un nombre entre 1 et 50 dans la cellule U11.", vbExclamation
End If
End If
' Vérifier si la modification a eu lieu dans la cellule U64
If Not Intersect(Target, Me.Range("U64")) Is Nothing Then
numLignes = Me.Range("U64").Value
' Vérifier si le nombre de lignes est valide (entre 1 et 50)
If numLignes >= 0 And numLignes <= 50 Then
' Afficher les lignes correspondantes pour la plage 66:115
For Each rng In ws.Rows("66:115")
If rng.Row <= 65 + numLignes Then
rng.Hidden = False
Else
rng.Hidden = True
End If
Next rng
Else
MsgBox "Veuillez saisir un nombre entre 1 et 50 dans la cellule U64.", vbExclamation
End If
End If
Application.ScreenUpdating = False
If Val([U11]) > 50 Then [U11] = 50
'Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 4) = "Item" Or Left(ws.Name, 4) = "Type" Then
ws.Columns("AO:EJ").Hidden = True
If Int(Val([U11])) > 0 Then ws.Columns("AO").Resize(, 2 * Int(Val([U11]))).Hidden = False
End If
Next ws
Application.ScreenUpdating = True
End Sub
Merci