Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Réduire un code

chaelie2015

XLDnaute Accro
Bonjour forum
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
Est-ce faisable ?
Merci
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…