Automisation VBA dans tableaux

Bonjour,

J'ai une feuille avec plusieurs tableaux identiques les uns a coté des autres. 6 colonnes de large 1000 ligne de long

mon premier tableau est mon tableau de référence. Dans les colones C;D;E doit s'éffectuer une fonction automatique.

J'ai créé un code qui fonctionne parfaitement pour mon premier tableau, quand j'ai voulu l'étendre pour les autres tableaux, rien n'a fonctionné.

il devrait fonctionner pour les colones IJK, OPQ, etc...

Petite explication du code,

- Quand je double clique sur une case de la colonne C il vérifie la case: Si il y a un "X" il le remplace par "Présent, dans la case de la colonne E, il va remplacer le "OUT" par un "X". Si c'est "Présent", il remplace par un "X", et dans la case de la colonne E, il remplace le "X" par "Out".

- Quand je double clique sur la case de la colonne D: S'il y a un "X", il le remplace par "LOAN" et met à 0 la couleur. SI c'est "Loan", il le remplace par "X"

Voici le code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rngPresent As Range
    Dim rngLoan As Range
    Dim cell As Range

    ' Plage de cellules à surveiller pour les "Présent"
    Set rngPresent = Me.Range("C3:C1000", "I3:I1000")

    ' Plage de cellules à surveiller pour les "Loan"
    Set rngLoan = Me.Range("D3:D1000", "J3:J1000")

    ' Vérifie si la cellule double-cliquée est dans la plage C3:C1000 (Présent)
    If Not Intersect(Target, rngPresent) Is Nothing Then
        Cancel = True ' Annule l'édition de la cellule
        For Each cell In Target
            If cell.Value = "Présent" Then
                ' Remplace "Présent" par un "X"
                cell.Value = "X"

                ' Met la cellule en noir
                cell.Interior.Color = RGB(0, 0, 0)

                ' Met "OUT" dans la colonne E sur la même ligne et remet la couleur par défaut
                With cell.Offset(0, 2)
                    .Value = "OUT"
                    .Interior.ColorIndex = xlNone
                End With
            ElseIf cell.Interior.Color = RGB(0, 0, 0) Then
                ' Remplace "X" par "Présent"
                cell.Value = "Présent"

                ' Remet la couleur de la cellule par défaut
                cell.Interior.ColorIndex = xlNone

                ' Met un "X" dans la colonne E sur la même ligne et met la cellule en noir
                With cell.Offset(0, 2)
                    .Value = "X"
                    .Interior.Color = RGB(0, 0, 0)
                End With
            End If
        Next cell
    End If

    ' Vérifie si la cellule double-cliquée est dans la plage D3:D1000 (Loan)
    If Not Intersect(Target, rngLoan) Is Nothing Then
        Cancel = True ' Annule l'édition de la cellule
        For Each cell In Target
            If cell.Value = "X" Then
                ' Remplace "X" par "Loan"
                cell.Value = "Loan"

                ' Remet la couleur de la cellule par défaut
                cell.Interior.ColorIndex = xlNone
            ElseIf cell.Value = "Loan" Then
                ' Remplace "Loan" par "X"
                cell.Value = "X"

                ' Met la cellule en noir
                cell.Interior.Color = RGB(0, 0, 0)
            End If
        Next cell
    End If
End Sub

Merci d'avance pour votre aide.

Devo.

Bonjour,

Vous devez simplement redéfinir les cellules "a surveiller" dans votre macro, afin qu'elle puisse toutes les détecter. Je parle de :

    ' Plage de cellules à surveiller pour les "Présent"
    Set rngPresent = Me.Range("C3:C1000", "I3:I1000")

    ' Plage de cellules à surveiller pour les "Loan"
    Set rngLoan = Me.Range("D3:D1000", "J3:J1000")

Cependant au vu de votre besoin, si vous atteignez un grand nombre de colonnes je vous propose de revoir votre approche :

Puisque vos tableaux suivent une structure répétitive, il existe une valeur k telle que la colonne 1 de n'importe quel tableau est un multiple de k.

Exemple :

Avec en 4e ligne le numéro de colonne, et en 5e ligne le résultat de la division euclidienne de ce numéro par 7 (nombre de colonnes de votre tableau + 1)
Vous remarquez la répétition. Ainsi au lieu de vérifier si votre cellule de click se trouve dans vos 2 ranges prédéfinies, vérifiez plutot si :

1. ResteDivisionEuclidienne(Numero de colonne de la cellule; 7) = 1 (reste de la divison euclidienne = Mod operator | Microsoft Learn en VBA)
2. Et numéro de ligne compris entre 1 et 1000.

Votre code sera plus rapide et s'adapte a n'importe quel nombre de tableaux.

Le numéro 7 à adapter en fonction de l'espacement de vos tableaux

Bonjour,

Merci pour votre réponse, je pense comprendre mais j'ai du mal à l'appliquer dans le code, pourriez-vous me redonner un petit coup de main ?

Bien à vous,

Devo

Rebonjour, une question votre macro semble faite pour cycler sur un "ensemble" de cellules qui seraient double cliquées... Est-ce le cas ou bien il suffit de vérifier simplement LA (unique) cellule double cliquée.

Auquel cas :

Remplacer

 If Not Intersect(Target, rngPresent) Is Nothing Then

Par

Dim colNum as Long, rowNum as Long
colNum = Target.Column
rowNum = Target.Row

If colNum > 2 And colNum Mod 10 < 10 Then
' pour les colonnes C à J
If rowNum <= 1000 Then
' pour les lignes 1 à 1000

Après si vous voulez quelque chose de plus précis vous devez envoyer un fichier exemple pour adapter le code a votre structure.

Bonjour,

Effectivement c'est uniquement la cellule double cliquée qui doit être check.

Voici un exemple de mon fichier :

Bonjour,

Ci-joint votre classeur avec le code mis à jour comme je vous l'indiquais. Bon je me suis permis de le "revoir" plus en profondeur mais le principe de base est celui évoqué.

Si vous avez des questions n'hésitez pas.

Ci-après le code en question :

Option Explicit

Private Const MIN_ROW As Long = 3
Private Const MAX_ROW As Long = 1000
Private Const COL_PRESENT As Long = 3
Private Const COL_LOAN As Long = 4

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  Dim colNum As Long, rowNum As Long
  ' l'opération "Mod" permet de se ramener sur les memes indices pour tous les tableaux
  ' avec 6, elle renvoie:
  ' A B C D E F G H I J K L M N O P Q...  <- colonne
  ' 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6   <- valeur renvoyée
  colNum = Target.Column Mod 6
  rowNum = Target.Row

  If rowNum <= MAX_ROW And rowNum >= MIN_ROW Then

    Select Case colNum
    Case COL_PRESENT
      Cancel = True                                ' annule l'action double clic classique
      With Target
        Select Case .Value2
        Case "Présent"
          .Value2 = "X"
          .Interior.Color = VBA.RGB(0, 0, 0)
          .Offset(0, 2).Value2 = "OUT"
          .Offset(0, 2).Interior.ColorIndex = xlNone
        Case Else                                ' "X"
          .Value2 = "Présent"
          .Interior.ColorIndex = xlNone
          .Offset(0, 2).Value2 = "X"
          .Offset(0, 2).Interior.Color = VBA.RGB(0, 0, 0)
        End Select
      End With
    Case COL_LOAN
      Cancel = True                                ' annule l'action double clic classique
      With Target
        Select Case .Value2
        Case "Loan"
          .Value2 = "X"
          .Interior.Color = VBA.RGB(0, 0, 0)
        Case Else                                ' "X"
          .Value2 = "Loan"
          .Interior.ColorIndex = xlNone
        End Select
      End With
    Case Else
      ' la cellule cliquée n'est pas dans les 2 indices de colonne recherchés
      Exit Sub
    End Select
  End If
End Sub

Rebonjour,

C'est parfait ! C'est exactement ce que je désirait :D

Merci beaucoup pour votre aide et votre rapidité :)

Cordialement,

Devoriis.