Création de diagonale dans une cellule avec une macro

Résolu
arnd21 Messages postés 11 Statut Membre -  
arnd21 Messages postés 11 Statut Membre -
Bonjour à tous,

Je souhaite:

En rentrant un petit "x" dans une case sur une feuille 1 que dans une feuille 2 apparaisse de diagonale dans une cellule. En gros que l'on est l'impression que la cellule soit barrée.
De plus si le "x" est enlevé dans la case de la feuille 1 les diagonales doivent disparaitre dans la cellule de la feuille 2.

Voici ma macro: 

Sub Essai()
'
' Essai Macro

'
    Sheets("Feuil1").Select
'   Dim nom As String
    nom = Range("B4")
    If nom = "x" Then
    
    Sheets("Feuil2").Select
    Range("S28").Select
    With Selection.Borders(xlDiagonalDown)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ElseIf nom = "" Then
    Sheets("Feuil2").Select
    Range("S28").Select
    With Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    End With
    With Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    End With
    
       
    End If

End Sub


Pour résumer les diagonales apparaissent bien dans la cellule de la feuille 2, cependant quand je retire le "x" une seule diagonale se retire de la cellule et non les 2.si vous avez une idée. Merci à tous.

5 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    une seule diagonal si pas x en B24 

    Sub Essai()
    '
    ' Essai Macro
    Sheets("Feuil1").Select
    ' Dim nom As String
    nom = Range("B4")
    If nom = "x" Then
        Sheets("Feuil2").Select
        Range("S28").Select
        With Selection.Borders(xlDiagonalDown)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlDiagonalUp)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
    ElseIf nom = "" Then
        Sheets("Feuil2").Select
        Range("S28").Select

        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        With Selection.Borders(xlDiagonalUp)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End If

    End Sub
    0
  2. Utilisateur anonyme
     
    Bonjour,
    x en B4 feuille 1 => 2 diagonales en S28 feuille 2
    rien en B4 feuille 1 = > plus de diagonales en S28 feuille 2 

    Sub Essai()
'
' Essai Macro

'
Sheets("Feuil1").Select
' Dim nom As String
nom = Range("B4")
If nom = "x" Then

Sheets("Feuil2").Select
Range("S28").Select
With Selection.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ElseIf nom = "" Then
Sheets("Feuil2").Select
Range("S28").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

End If

End Sub
    0
  3. arnd21 Messages postés 11 Statut Membre
     
    Super merci ca fonctionne!! mais pourquoi doit-on enlever le with and end with : 
    ElseIf nom = "" Then 
    Sheets("Feuil2").Select 
    Range("S28").Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Merci par avance
    0
    1. Utilisateur anonyme
       
      Si tu veux garder le With et le End With, il faut juste que tu mettes .LineStyle en dessous pour que cela fonctionne correctement
      voici la partie de code : 



      ElseIf nom = "" Then
      Sheets("Feuil2").Select
      Range("S28").Select
      With Selection.Borders(xlDiagonalDown)
      .LineStyle = xlNone
      End With
      With Selection.Borders(xlDiagonalUp)
      .LineStyle = xlNone
      End With

      End If
      0
    2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Règle de base en VBA: Eviter au maximum les Select-SelectionN !!!
      0
  4. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour,

    Peut-^tre moins lourd: 
    Option Explicit
    '----------------------------------------------
    Sub Essai()
    Dim nom As String

    nom = Sheets("Feuil1").Range("B4")
     With Sheets("Feuil2").Range("S28")
         If nom = "x" Then
              .Borders(xlDiagonalDown).Weight = xlThin
              .Borders(xlDiagonalUp).Weight = xlThin
              .Borders.LineStyle = xlNone
         Else
              .Borders(xlDiagonalDown).LineStyle = xlNone
              .Borders(xlDiagonalUp).LineStyle = xlNone
        End If
    End With
    Sheets(2).Activate
    End Sub

    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. arnd21 Messages postés 11 Statut Membre
     
    Merci Michel,

    J'ai finalement réussi à faire la manip ;-)

    Sympa de vous être pencher sur mon sujet.
    0

Discussions similaires

Excel formule : savoir si une cellule contient partie texte
plunderer007 -
francois -

14 réponses
séparer une cellule par une diagonale
rosinelaure -
rosinelaure -

3 réponses
Séparer une cellule en oblique
nemotri -
Dyson233323232 -

20 réponses