Microsoft 365 Bordures dans MFC

[rastafouette]

Bonjour à tous,

Je cherche à mettre des bordures dans une MFC, mais je ne peux pas sélectionner les diagonales, pour faire une croix dans la cellule. J'ai essayé sur plusieurs fichiers, même sur des nouveaux vides.
Est-ce normal ?

 

[Staple1600]

Re


@rastafouette
J'ai pas mieux, mais pire

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PLAGE As Range, VERIF
Set PLAGE = Range("d80:x110")
If Not Application.Intersect(Target, PLAGE) Is Nothing Then
VERIF = Application.WorksheetFunction.CountA(PLAGE)
Select Case VERIF
Case 651
MsgBox "Saisie compléte!"
Case Else
MsgBox "Saisie incompléte!", vbCritical
End Select
End If
End Sub

De quoi jeter son PC par la fenêtre

 

[eriiic]

Bonjour à tous,
dans les motifs tu as aussi hachuré, ou des points plus légers, ça reste en MFC.
Bien sûr les utilisateurs doivent connaitre le code, info simple à faire passer.

Sinon tant qu'à mettre du vba, autant verrouiller en plus la cellule en empêchant sa sélection. Ca sécurise ta feuille.
eric

 

[Phil69970]

@rastafouette

Ce n'est pas forcément très beau. Si vous avez mieux, je prends

Je te propose :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Cell As Range, Plage As Range
Set Plage = Range("D80:X110")
If Not Application.Intersect(Target, Plage) Is Nothing Then
    Plage.Borders(xlDiagonalUp).LineStyle = xlNone
    Plage.Borders(xlDiagonalDown).LineStyle = xlNone
    For Each Cell In Plage.SpecialCells(xlCellTypeBlanks)
        With Cell
            .Borders(xlDiagonalUp).LineStyle = xlContinuous
            .Borders(xlDiagonalDown).LineStyle = xlContinuous
            .Borders(xlDiagonalDown).Weight = xlThick ' <== Est ce vraiment utile et indispensable ????
        End With
    Next Cell
End If
End Sub

Tu travailles avec des bourrins et encore c'est la version soft

Le souci n'est même pas là. Je suis seule à maniper le xlsx. Le tableau lui est imprimé chaque semaine. Et une case "juste" grisée, même foncée (déjà fait semaines dernières) n'est pas aussi claire qu'une case rayée diagonale (qui, elle, signifie manifestement mieux le "non") => sources d'erreurs
Il faut que visuellement, ça se comprenne tout de suite, même pour celui qui ne connait pas, sans avoir besoin de donner d'explications et sans trop changer de l'ancien modèle : peu peu de marge de manœuvre. => rayée diagonales

et comme le dit Staple

Effectivement, ca pique les yeux
C'est violent
Je viens de tester et j'en ai attrapée une migraine !

Et dans la série encore plus violent il y a ceci :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Cell As Range, Plage As Range
Set Plage = Range("D80:X110")
If Not Application.Intersect(Target, Plage) Is Nothing Then
    '*** Pour supprimer l'existant la 1ere fois si tu ne pars pas d'une feuille vierge !!!!
    Plage.Borders(xlDiagonalUp).LineStyle = xlNone
    Plage.Borders(xlDiagonalDown).LineStyle = xlNone
    '****
    Plage.Interior.ColorIndex = xlNone
    For Each Cell In Plage.SpecialCells(xlCellTypeBlanks)
        With Cell
            .Interior.ColorIndex = 1
        End With
    Next Cell
End If
End Sub

Et tu es sur qu'ils comprendront bien ce que cela veux dire !!!

Il faut que visuellement, ça se comprenne tout de suite, même pour celui qui ne connait pas, sans avoir besoin de donner d'explications

Merci de ton retour

 

[rastafouette]

Merci @Phil69970
Ces 2 soluces là me conviennent bien.

Merci pour l'embellissement

 

[Staple1600]

Bonsoir

@Phil69970
Il n'y a pas besoin de boucle ,non ?
Ou il y a un truc qui m'échappe

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Cell As Range, Plage As Range
Set Plage = Range("D80:X110")
If Not Application.Intersect(Target, Plage) Is Nothing Then
    '*** Pour supprimer l'existant la 1ere fois si tu ne pars pas d'une feuille vierge !!!!
'Plage.Borders(xlDiagonalUp).LineStyle = xlNone
'Plage.Borders(xlDiagonalDown).LineStyle = xlNone
Plage.Interior.ColorIndex = xlNone
Plage.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 1
End If
End Sub

Ci-dessous la version à ne pas tester
(risque de dommage sur le nerf optique)

Spoiler: a vos risques et périls ;-)

'La macro originale est de Phil69970
'L'ajout futile et gagesque, c'est bibi
'A ne pas utiliser en milieu professionnel
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Cell As Range, Plage As Range
Set Plage = Range("D80:X110")
If Not Application.Intersect(Target, Plage) Is Nothing Then
Plage.Interior.ColorIndex = xlNone
    For Each Cell In Plage.SpecialCells(4)
        With Cell
        Randomize 1600
            .Interior.Color = RGB(225 * Rnd, 255 * Rnd, 255 * Rnd)
        End With
    Next Cell
End If
End Sub

 

[Phil69970]

Bonsoir staple

Il n'y a pas besoin de boucle ,non ?

Exact
Plus les yeux en face des trous ..... vu l'heure du message !!!
Mais c'est quand même violent et devrait plaire au demandeur ......

 

[Staple1600]

RE

@Phil69970
J'ai fait dans l'ultraviolence sur la base de ton travail
Voir édition de mon précédent message