MFC bordures via VBA

[WocaM]

Bonjour le forum

voilà mon soucis

dans un tableau (lundi à dimanche), je voudrais que lorsque je marque un "X" dans une case,
une MFC de bordures s'applique à 2 autres cases et évidement si j'enlève le "X" la MFC doit disparaitre

j'arrive à la faire pour une case mais comment le faire pour vérifier la présence du "X" dans toutes les cases
(B8 à H27 dans l'exemple si joint) sans répéter tout le temps le même code

je suis pas trop bon dans les boucles ! ! ! !

Merci de vos lumières d'avance
Gildas

PS: dans l'exemple j'ai juste mis le résultat attendu

 

[Grand Chaman Excel]

Re : MFC bordures via VBA

Bonjour WocaM,

Je ne maîtrise pas vraiment les MFC par VBA alors voici une proposition en utilisant des colonnes intermédiaires (à cacher si tu veux).
Il y a sûrement une solution plus élégante mais celle-ci n'est quand même pas trop complexe à appliquer.

A+

 

[Fred0o]

Re : MFC bordures via VBA

Bonsoir à tous,

Cette formule est à mettre en MFC sur la zone $J$8:$W$27, en choisissant la bordure qui te convient le mieux :

=DECALER($B8;0;ARRONDI.INF(COLONNE()/2;0)-5)="X"

A+

 

[WocaM]

Re : MFC bordures via VBA

Merci de vos réponses

Mais en fait je viens de trouver exactement ce que je voulais par moi-même
ce que je n'avais pas précisé c'est que je voulais une bordure épaisse (impossible à faire avec une MFC classique)

et j'ai trouvé la réponse dans un autre post en prenant le problème à l'envers
d'office mes cellules ont une bordure grasse et ensuite je viens appliqué une MFC "pointillé" si la case ne contient pas un "X"

MFC =!$G20<>"x" sur les cellules $T$8:$T$27 pour le samedi par exemple

cela ne me fais que 7 MFC une par jour de la semaine seulement alors que je pensais en avoir plus de 100 ! ! !

Mais du coup je tombe sur un autre soucis, sur une autre partie de mon fichier j'ai réutilisé un code de MFC multiple de myDearFriend
or je voudrais que la MFC se fasse sur 2 cellules fusionner mais avec le code de myDearFriend cela me defusionne les cellules

Option Explicit
'---------------------------------------------------------------------------------------
' Auteur    : Didier FOURGEOT (myDearFriend!)
' Date      : 18/09/2005
' Sujet     : MFC multiples
'---------------------------------------------------------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim TabTemp As Variant
Dim L As Long
Dim V As Variant
    'Ne gère pas les sélections de plages
    If Target.Cells.Count > 1 Then Exit Sub
    'Vérifie la présence du format conditionnel "spécial"
    If Target.FormatConditions.Count < 1 Then Exit Sub
    If Target.FormatConditions(1).Formula1 = "=mDF" Then
        With Sheets("MFC")
            'Charge les préférences dans un tableau variant temporaire
            L = .Range("A65536").End(xlUp).Row
            TabTemp = .Range(.Cells(1, 1), .Cells(L, 1)).Value
            'Détermine le format à utiliser suivant la valeur de la cellule
            If Target.Value = "" Then
                L = 1
            Else
                For L = 2 To UBound(TabTemp, 1)
                    If Target.Value = TabTemp(L, 1) Then Exit For
                Next L
            End If
            'Gestion des erreurs (impératif, compte tenu de la désactivation des évènements)
            On Error GoTo Fin
            Application.EnableEvents = False
            'Applique le format (sauf les bordures)
            .Cells(L, 2).Copy
            V = Target.Formula
            Target.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
            Target.Formula = V
            'Il semble que sur Mac et dans certaines situations (non ciblées) le format
            'conditionnel "spécial" d'origine ne soit pas écrasé par le nouveau, il convient
            'donc de s'en assurer avant de réimposer ce format spécial.
            If Target.FormatConditions.Count < 1 Then Target.FormatConditions.Add Type:=xlExpression, Formula1:="=mDF"
            Application.CutCopyMode = False
            Application.EnableEvents = True
        End With
    End If
    Exit Sub
Fin:
    'En cas d'erreur dans le code, il convient impérativement de rétablir la gestion des
    'évènements d'application pour la suite. Par une gestion d'erreur, on réaffecte la
    'valeur True à la propriété Application.EnableEvents et on informe l'utilisateur qu'une
    'erreur non gérée est survenue
    MsgBox "Erreur non gérée dans la procédure Workbook.SheetChange()" & vbLf & "Erreur : " & _
        Err & " " & Err.Description, vbOKOnly, "myDearFriend!"
    Application.EnableEvents = True
End Sub

si vous avez des idées la dessus merci d'avance, je continu de chercher

A+ Gildas

 

[WocaM]

Re : MFC bordures via VBA

Bonjour

je reveins sur ce fil car la solution que je pensais avoir trouvé en faite ne marche pas
chez moi je suis en excel 2010 et cela fonctionnais au petits oignons mais de retour au travail
là ca ne marche plus du tout nous sommes en excel 2007

J'ai essayé la solution de Fred0o mais ca ne marche pas
Je pensais plus a une macro sous vba qui scurterai un tableau (B8:I27) dans mon exemple pour appliquer des bordures de J à W

donc si quelqu'un a une solution je suis preneur merci

Cordialement
Gildas

 

[Si...]

Re : MFC bordures via VBA

salut

à tester

Private Sub Worksheet_Change(ByVal R As Range)
  If R.Count < 1 Then Exit Sub
  If Intersect(R, Range("B8:H27")) Is Nothing Then Exit Sub
  Dim C As Byte
  C = (R.Column + 3) * 2
  With Range(Cells(R.Row, C), Cells(R.Row, C + 1)).Borders(xlEdgeBottom)
     .LineStyle = 1
      If UCase(R) = "X" Then
        .ThemeColor = 10
        .TintAndShade = -0.249946592608417
        .Weight = xlThick
      Else
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
     End If
   End With
End Sub

 

[WocaM]

Re : MFC bordures via VBA

Bonjour Si...

ton code marche bien comme je voudrais par contre si je supprime plusieurs "X" d'un coup
cela me donne une erreur 13 "incompatibité de type"

Cordialement
Gildas

 

[tototiti2008]

Re : MFC bordures via VBA

Bonjour à tous,

Peut-être, légère modification du code de Si...

Private Sub Worksheet_Change(ByVal R As Range)
  If Intersect(R, Range("B8:H27")) Is Nothing Then Exit Sub
  Dim C As Byte, Cellule as Range
  For each Cellule in R
  C = (Cellule.Column + 3) * 2
  With Range(Cells(Cellule.Row, C), Cells(Cellule.Row, C + 1)).Borders(xlEdgeBottom)
     .LineStyle = 1
      If UCase(Cellule) = "X" Then
        .ThemeColor = 10
        .TintAndShade = -0.249946592608417
        .Weight = xlThick
      Else
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
     End If
   End With
Next
End Sub

 

[WocaM]

Re : MFC bordures via VBA

Bonjour tototiti2008

Ta legere modification marche parfaitement
par contre j'ai un autre soucis maintenant (pas lié à ta modif)
en fait dans mes cellules ou on regarde si il y a un "X"
celles ci sont fusionnées, donc j'ai modifé le bout de code mais du coup cela me crée un décalage
dans l'exemple ci-joint ca sera plus parlant

Merci d'avance de vos lumières
Gildas

 

[Si...]

Re : MFC bordures via VBA

re

remplace C = (Cellule.Column + 7) * 2 par C=Cellule.Column + 16

MerSi... tototiti pour l'ajout.

 

[WocaM]

Re : MFC bordures via VBA

re egalement

cela marche presque ! !

pour la MFC à l'écriture pas de soucis, par contre si je supprime un X
cela m'enlève la MFC sur 3 cases et non pas 2

Cordialement
Gildas

 

[tototiti2008]

Re : MFC bordures via VBA

Re,

@Si... : de rien 🙂

@ WocaM : décide toi une bonne fois sur les cellules à fusionner ou pas, ça va changer le code à chaque fois, et ça ne simplifie pas le code de fusionner les cellules
C'est bien la présentation définitive (côté fusion) ?

 

[WocaM]

Re : MFC bordures via VBA

Je sais que c'est pas l'idéal pour les cellules fusionnés
Dans mon fichier final les colonnes fusionnés seront les colonnes A à N 2 par 2 (AB, CD, etc...)

j'ai mis en exemple la forme definitive que je vais utiliser après dans mon fichier final
ca sera plus pratique pour trouver la bonne solution

Cordialement
Gildas