Création de diagonale dans une cellule avec une macro

Résolu/Fermé

arnd21 Messages postés 11 Date d'inscription mardi 4 février 2014 Statut Membre Dernière intervention 26 mars 2014 - Modifié par pijaku le 5/02/2014 à 08:44
arnd21 Messages postés 11 Date d'inscription mardi 4 février 2014 Statut Membre Dernière intervention 26 mars 2014 - 6 févr. 2014 à 20:19

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:

Création de diagonale dans une cellule avec une macro
Aller à la ligne dans une cellule excel - Guide
Creation compte gmail - Guide
Media creation tool - Télécharger - Systèmes d'exploitation
Macro word - Guide
Bloquer une cellule excel - Guide

5 réponses

Réponse 1 / 5

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 févr. 2014 à 08:50

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

Réponse 2 / 5

Utilisateur anonyme
Modifié par pijaku le 5/02/2014 à 08:44

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

Réponse 3 / 5

arnd21 Messages postés 11 Date d'inscription mardi 4 février 2014 Statut Membre Dernière intervention 26 mars 2014
Modifié par pijaku le 5/02/2014 à 08:44

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

Utilisateur anonyme
Modifié par pijaku le 5/02/2014 à 08:45

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

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
5 févr. 2014 à 08:39

Règle de base en VBA: Eviter au maximum les Select-SelectionN !!!

Réponse 4 / 5

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
4 févr. 2014 à 14:03

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

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 mardi 4 février 2014 Statut Membre Dernière intervention 26 mars 2014
6 févr. 2014 à 20:19

Merci Michel,

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

Sympa de vous être pencher sur mon sujet.

Discussions similaires

séparer une cellule par une diagonale

Excel : colorer une cellule sous condition d'une autre ?

Formule Excel : "SI" une cellule contient un mot, alors ?

Discussions similaires

Newsletters