Afficher un message
Vieux 22/06/2007, 20h51   #6 (permalink)
Youri
XLDnaute Junior
 
Date d'inscription: mai 2007
Messages: 99
Par défaut Re : Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

Bonjour Pierre Olivier,

Merci pour le coup de main mais je m'en suis sorti avec "On Error Resume Next", On Error GoTo 0 et une condition supplémentaire ce qui m'a permis de quand même effacer les données si jamais la cellule A1 fait partie de la sélection. D'ailleurs, j'ai essayé de reproduire le même comportement dans une autre feuille et ça marche pas. Avis aux amateurs : voici le code :
Code:
Private preceffA As Variant
Private preceffB As Variant
Private preceffC As Variant
Private preceffD As Variant
Private preceffE As Variant
Private preceffF As Variant
Private preceffG As Variant
Private preceffH As Variant
Private preceffI As Variant
Private preceffJ As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$207" Then preceffA = Target.Value
If Target.Address = "$F$207" Then preceffB = Target.Value
If Target.Address = "$C$234" Then preceffC = Target.Value
If Target.Address = "$F$234" Then preceffD = Target.Value
If Target.Address = "$C$261" Then preceffE = Target.Value
If Target.Address = "$F$261" Then preceffF = Target.Value
If Target.Address = "$C$288" Then preceffG = Target.Value
If Target.Address = "$F$288" Then preceffH = Target.Value
If Target.Address = "$C$315" Then preceffI = Target.Value
If Target.Address = "$F$315" Then preceffJ = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim celA As Range
Dim comptA As Byte
Dim celB As Range
Dim comptB As Byte
Dim celC As Range
Dim comptC As Byte
Dim celD As Range
Dim comptD As Byte
Dim celE As Range
Dim comptE As Byte
Dim celF As Range
Dim comptF As Byte
Dim celG As Range
Dim comptG As Byte
Dim celH As Range
Dim comptH As Byte
Dim celI As Range
Dim comptI As Byte
Dim CellConc As Range
Dim Plage As Range
Dim TempConcatenation As String
Dim CellConc2 As Range
Dim Plage2 As Range
Dim TempConcatenation2 As String
Dim CellConc3 As Range
Dim Plage3 As Range
Dim TempConcatenation3 As String
Dim CellConc4 As Range
Dim Plage4 As Range
Dim TempConcatenation4 As String
Dim CellConc5 As Range
Dim Plage5 As Range
Dim TempConcatenation5 As String
Dim CelleffA As Range
Dim PlageeffA As Range
Dim CelleffB As Range
Dim PlageeffB As Range
Dim CelleffC As Range
Dim PlageeffC As Range
Dim CelleffD As Range
Dim PlageeffD As Range
Dim CelleffE As Range
Dim PlageeffE As Range
Dim CelleffF As Range
Dim PlageeffF As Range
Dim CelleffG As Range
Dim PlageeffG As Range
Dim CelleffH As Range
Dim PlageeffH As Range
Dim CelleffI As Range
Dim PlageeffI As Range
Dim CelleffJ As Range
Dim PlageeffJ As Range
With Worksheets("Fiche de renseignements")
    On Error Resume Next
    If Target.Address = "$C$207" And Target.Value <> preceffA Then
    If Target.Address = "$C$207" Then
    Set PlageeffA = Range("C208:C231")
        For Each CelleffA In PlageeffA
            If CelleffA.Value <> 0 And CelleffA.Value <> "" Then
                CelleffA.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$207" And Target.Value <> preceffB Then
    If Target.Address = "$F$207" Then
    Set PlageeffB = Range("F208:F231")
        For Each CelleffB In PlageeffB
            If CelleffB.Value <> 0 And CelleffB.Value <> "" Then
                CelleffB.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$234" And Target.Value <> preceffC Then
    If Target.Address = "$C$234" Then
    Set PlageeffC = Range("C235:C258")
        For Each CelleffC In PlageeffC
            If CelleffC.Value <> 0 And CelleffC.Value <> "" Then
                CelleffC.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$234" And Target.Value <> preceffD Then
    If Target.Address = "$F$234" Then
    Set PlageeffD = Range("F235:F258")
        For Each CelleffD In PlageeffD
            If CelleffD.Value <> 0 And CelleffD.Value <> "" Then
                CelleffD.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$261" And Target.Value <> preceffE Then
    If Target.Address = "$C$261" Then
    Set PlageeffE = Range("C262:C285")
        For Each CelleffE In PlageeffE
            If CelleffE.Value <> 0 And CelleffE.Value <> "" Then
                CelleffE.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$261" And Target.Value <> preceffF Then
    If Target.Address = "$F$261" Then
    Set PlageeffF = Range("F262:F285")
        For Each CelleffF In PlageeffF
            If CelleffF.Value <> 0 And CelleffF.Value <> "" Then
                CelleffF.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$288" And Target.Value <> preceffG Then
    If Target.Address = "$C$288" Then
    Set PlageeffG = Range("C289:C312")
        For Each CelleffG In PlageeffG
            If CelleffG.Value <> 0 And CelleffG.Value <> "" Then
                CelleffG.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$288" And Target.Value <> preceffH Then
    If Target.Address = "$F$288" Then
    Set PlageeffH = Range("F289:F312")
        For Each CelleffH In PlageeffH
            If CelleffH.Value <> 0 And CelleffH.Value <> "" Then
                CelleffH.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$315" And Target.Value <> preceffI Then
    If Target.Address = "$C$315" Then
    Set PlageeffI = Range("C316:C339")
        For Each CelleffI In PlageeffI
            If CelleffI.Value <> 0 And CelleffI.Value <> "" Then
                CelleffI.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$315" And Target.Value <> preceffJ Then
    If Target.Address = "$F$315" Then
    Set PlageeffJ = Range("F316:F339")
        For Each CelleffJ In PlageeffJ
            If CelleffJ.Value <> 0 And CelleffJ.Value <> "" Then
                CelleffJ.ClearContents
            End If
        Next
    End If
    End If
    On Error GoTo 0
End With
    For Each celA In Range("F47:F59")
        If celA <> "" And celA <> 0 Then
           comptA = comptA + 1
        End If
    Next
    If comptA > 0 Then
        If Range("F60:F74").EntireRow.Hidden = True Then
            Range("F60:F74").EntireRow.Hidden = False
        End If
        Else
        If Range("F60:F74").EntireRow.Hidden = False Then
            Range("F60:F74").EntireRow.Hidden = True
        End If
    End If
    For Each celB In Range("F62:F74")
        If celB <> "" And celB <> 0 Then
           comptB = comptB + 1
        End If
    Next
    If comptB > 0 Then
        If Range("F75:F89").EntireRow.Hidden = True Then
            Range("F75:F89").EntireRow.Hidden = False
        End If
        Else
        If Range("F75:F89").EntireRow.Hidden = False Then
            Range("F75:F89").EntireRow.Hidden = True
        End If
    End If
    For Each celC In Range("F77:F89")
        If celC <> "" And celC <> 0 Then
           comptC = comptC + 1
        End If
    Next
    If comptC > 0 Then
        If Range("F90:F104").EntireRow.Hidden = True Then
            Range("F90:F104").EntireRow.Hidden = False
        End If
        Else
        If Range("F90:F104").EntireRow.Hidden = False Then
            Range("F90:F104").EntireRow.Hidden = True
        End If
    End If
Bonne journée,
Youri
Youri est déconnecté   Réponse avec citation