Création de diagonale dans une cellule avec une macro

Résolu
arnd21 Messages postés 11 Date d'inscription   Statut Membre Dernière intervention   -  
arnd21 Messages postés 11 Date d'inscription   Statut Membre Dernière intervention   -
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.
A voir également:

5 réponses

Réponse 1 / 5
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
Réponse 2 / 5
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
Réponse 3 / 5
arnd21 Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
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
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
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313
 
Règle de base en VBA: Eviter au maximum les Select-SelectionN !!!
0
Réponse 4 / 5
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313
 
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

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

Posez votre question
Réponse 5 / 5
arnd21 Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
Merci Michel,

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

Sympa de vous être pencher sur mon sujet.
0

Discussions similaires

excel fractionner une cellule horizontalement
jalil -
barbiy -

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

3 réponses