Microsoft 365 Bordures dans MFC

rastafouette · 5 Octobre 2024

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 ?

Phil69970 · 8 Octobre 2024

@rastafouette

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

Je te propose :

VB:

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...

Staple1600 · 7 Octobre 2024

Re

@rastafouette
J'ai pas mieux, mais pire

VB:

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 · 7 Octobre 2024

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 · 8 Octobre 2024

@rastafouette

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

Je te propose :

VB:

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

rastafouette à dit:
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

Staple1600 à dit:
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 :

VB:

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 !!!

rastafouette à dit:
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 · 8 Octobre 2024

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

Merci pour l'embellissement

Staple1600 · 8 Octobre 2024

Bonsoir

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

Code:

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)

VB:

'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 · 8 Octobre 2024

Bonsoir staple

Staple1600 à dit:
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 · 8 Octobre 2024

RE

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

Microsoft 365 Bordures dans MFC

rastafouette

XLDnaute Occasionnel

Phil69970

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

rastafouette

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires