VBA : exécuter la validation de cellule

chris à dit:

Bonjour

J'ai enfin trouvé le temps de me repencher sur ce problème.

Je précise que le code de job75 marche très bien dans la plupart des cas mais dans le cas qui m'occupait, les validations ne sont pas définies en dehors des tableaux d'autant qu'il y a dans certains cas des tableaux les uns sous les autres avec des règles différentes.

Les échanges avec Job75 tant sur le forum qu'en MP ont bien fait avancé mon schmilblick.

Ci-joint un classeur avec les principe retenus et le code.
A priori il fonctionne et peut donc rendre service à ceux qui utilisent les tableaux et la protection.

Si certains ont des remarques ou envie de l'améliorer...

Cliquez pour agrandir...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim Target2, RRow As Range
Dim TblMois As ListObject        'Tableau
Dim Y                       'stockage temporaire saise

Set TblMois = Sh.ListObjects(1)
If Sh.ProtectContents = False Then Exit Sub

    'Position de la saisie
If Target.Row = TblMois.DataBodyRange.Rows.Count + TblMois.HeaderRowRange.Row Then
  'If Target.Cells(1, 1).Value = "" Then Exit Sub
    
    If Not (Intersect(Sh.Range(Sh.Cells(1, Target.Column), Sh.Cells(Sh.Cells.Rows.Count, Target.Column)), TblMois.Range) Is Nothing) Then
      Application.ScreenUpdating = False
      Sh.Unprotect 'Password:=Monpass
      Y = Target.Value
      'Application.EnableEvents = false
            
        For Each RRow In Target.Rows 'Ajout d'une ligne dans le tableau
          TblMois.ListRows.Add
        Next
        
        Set Target2 = Target.Offset(-Target.Rows.Count, 0) 'Nouvelle position de la saisie
        Target2 = Y
        Target.Offset(0, 1).Select
        'Sh.Protect UserInterfaceOnly:=True, Password:=Monpass
        Sh.Protect
        'Application.EnableEvents = True
        Application.ScreenUpdating = True
            
      End If
End If

End Sub

CortoXls à dit:

Par contre j'ai un peu de mal à comprendre la syntaxe de la ligne suivante :
If Not (Intersect(Sh.Range(Sh.Cells(1, Target.Column), Sh.Cells(Sh.Cells.Rows.Count, Target.Column)), TblMois.Range) Is Nothing) Then

Cliquez pour agrandir...

If Not (Intersect(Target(1).EntireColumn, TblMois.Range) Is Nothing) Then

job75 à dit:

Bonjour CortoXls, le forum,

Cette instruction est équivalente à :

VB:

If Not (Intersect(Target(1).EntireColumn, TblMois.Range) Is Nothing) Then

A+

Cliquez pour agrandir...