Bonjour, Est-ce qu'il est possible de modifier la plage "A:A, C:C, E:E" de la méthode Intersect ci-dessous : If Not Application.Intersect(Target, Range("A:A, C:C, E:E")) Is Nothing Then À savoir : o A:A pourrai devenir => A5: dernière cellule de la colonne A du tableau et ce quel que soit le nombre de lignes de celui-ci . o Pareil pour les deux autres L'idée est, qu'à chaque nouvelle ligne de créée, la plage s'incrémente automatiquement. Cela permettra déjà de rester dans le tableau et de ne pas le limiter, du style par exemple, A5:A50 ou d'en mettre trop : A5:A65… Merci pour votre aide. Cordialement

Modification de la plage "Method Intersect"

Anonyme

bonjour,

pour information, les feuilles "Concours" & "Repechage" sont identiques (copier/coller) aussi bien la feuille que le programme(adapter le nom de la feuille pour protéger celle-ci).

Sur la feuille "Concours", il n'y a pas de problèmes.

Il n'y a pas le feu et si c'est trop embêtant, on laisse tomber.

Bonne journée.

0 commentaires

DanielCo 107.1K

Remplace la macro Worksheet_SelectionChange de la feuille "Repechage" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Teste = True Then Range(ResAdr).Select

'*************************************************************************************************************

'inscription

If Target.Count = 1 And Target.Column = 2 And Sheets("Concours").ProtectContents = True Then

MessInscription = MsgBox("Voulez-vous inscrire une équipe ?", vbInformation + vbYesNo, "Inscription")

If MessInscription = vbYes Then

Sheets("Repechage").Unprotect

' Target.Offset(, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous

If Range("B5") = "" Then

Range("B5").Value = 1

Target.Offset(, 1).Select

Range("C" & ActiveSheet.Rows.Count).End(xlUp).Select

Else

Cells(Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1, 2).Value = _

Application.WorksheetFunction.Max(Range("B:B")) + 1

Cells(Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row, 2).Borders(xlEdgeRight).LineStyle = _

xlContinuous

Exit Sub

End If

If MessInscription = vbNo Then

Range("A1").Select

Sheets("Repechage").Protect

Exit Sub

End If

'*************************************************************************************************************

'changer nom équipe

' If Not Intersect(Target, [C5:C100]) Is Nothing Then

If Not Intersect(Target, Intersect(Range("C:C"), Range("5:" & Cells(Rows.Count, 2).End(xlUp).Row))) Is Nothing Then

If Target.Value <> "" Then

MessChangementNom = MsgBox(" Voulez-vous changer le nom de l'équipe ?", vbInformation + vbYesNo, "Change ""Nom équipe""")

If MessChangementNom = vbYes Then

Sheets("Repechage").Unprotect

Target.Value = ""

' Target.Offset(, 2) = "": Target.Offset(, 3) = "": Target.Offset(, 5) = ""

' Target.Offset(, 6) = "": Target.Offset(, 8) = "": Target.Offset(, 9) = ""

If Range("B5") = "" Then

Range("B5").Value = 1

Target.Offset(, 1).Select

Range("C" & ActiveSheet.Rows.Count).End(xlUp).Select

End If

Else

Range("A1").Select

Sheets("Repechage").Protect

Exit Sub

End If

'*************************************************************************************************************

'supprimer équipe

' If Not Intersect(Target, [A5:A100]) Is Nothing Then

If Not Intersect(Target, Intersect(Range("A:A"), Range("5:" & Cells(Rows.Count, 2).End(xlUp).Row))) Is Nothing Then

MessSupprimerEquipe = MsgBox(" Voulez-vous supprimer cette équipe ?", vbInformation + vbYesNo, "Supression ""Equipe""")

If MessSupprimerEquipe = vbYes Then

Sheets("Repechage").Unprotect

If Target.Offset(, 1) = "" Then

MsgBox "Vous ne pouvez pas supprimer cette ligne" & Chr(10) & "car vous êtes en dehors du tableau.", vbCritical, "Supression ""Equipe"""

End If

Range("A1").Select

If Target.Offset(, 1) <> "" Then

Target.Offset(, 1).Resize(, 24).Delete

End If

Sheets("Repechage").Protect

End If

'*************************************************************************************************************

'supprimer le message "Excel" et empêcher de modifier la valeur

Application.EnableEvents = False

If Target.Locked Then

MsgBox "Cette cellule est protégée.", vbInformation, "Protection des cellules"

Range("A1").Select

End If

Application.EnableEvents = True

End Sub

Daniel

0 commentaires

DanielCo 107.1K

Oui, il y a un problème avec le tableau de la feuille "repechage". On peut modifier le code comme indiqué dans mon précédent message ou attribuer un style personnalisé au tableau :

https://mon-partage.fr/f/UhjiW8Wg/

Daniel

0 commentaires

Anonyme

bonjour,

je me suis créé un compte sur "mon-partage. J'ai peut-être loupé quelque chose car à l'ouverture j'ai ce message :

Pour revenir aux bordures, il y a un petit souci. Quand tu crée une ligne, les bordures sont correctes, par contre, quand tu veux continuer les inscriptions, on retombe dans les mêmes travers.

J'ai résolu ce souci, en rajoutant ta ligne de code dans le paragraphe "Contrôle inscription" et là c'est parfait.

Cells(Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row, 2).Borders(xlEdgeRight).LineStyle = _

xlContinuous

Merci encore beaucoup pour aide et bonnes fêtes de Pâques.

Cordialement

0 commentaires

Anonyme

Bonjour,

If Not Intersect(Target, Intersect(Range("E:E, H:H, K:K"), Range("5:" & Cells(Rows.Count, 2).End(xlUp).Row))) Is Nothing Then

Pourrais-tu me transformer, STP, les lignes de code ci-dessous pour obtenir le résultat ci-dessus, c’est-à-dire pas de limites dans le tableau. Merci.

Ligne = Application.Match(Target.Offset(, -1), [B5:B100], 0)

Ligne = Application.Match(Target.Value, [B5:B100], 0)

Ligne = Application.Match(Target.Value, [B5:B100], 0) + 4

If Not IsNumeric(Application.Match(Target.Value, [B5:B100], 0)) Then

Cordialement

0 commentaires

Modification de la plage "Method Intersect"

29 réponses