XL 2013 Formater hauteur de ligne aller et retour

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonnjour à toutes et à tous,

Je me permets de vous solliciter à nouveau car je n'arrive pas à trouver la bonne solution à mon souci.

Je souhaite :
1 formater la cellule (donc la ligne) active à une hauteur,
2 que cette ligne soit remise à sa hauteur initiale quand je clique dans une cellule d'un autre ligne.
Malgré mes tests et recherches, je n'ai pas trouvé.

J'ai fait ce petit code qui fonctionne bien pour le point 1
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
On Error Resume Next
If Not Intersect(R, Range("a1:v10000")) Is Nothing And R.Count = 1 Then
    ActiveCell.RowHeight = 300
    End If
End Sub

Le fichier joint sera peut-être plus explicite que mes vagabondages LOL

Je vous remercie, comme toujours de votre gentillesse.
Bonne fin de journée,
Amicalement,
Lionel,
 

Pièces jointes

Re-Bonjour Eriic,

LOL l'affaire se corse 😎

J'ai besoin de re-formater certaines cellules quand elles sont mises à hauteur
- hauteur 50 (ligne précédente mémorisée) cellules police = blanc et gris clair
- hauteur 300 cellules police = noir standard
et je n'y arrive pas.
Voici le code que j'ai fait à partir de ton code :
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
'affiche ligne hauteur 50 ou 300
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=""
    'Static memoLigne As Range
    If R.Row < 7 Then Exit Sub
    If Not memoLigne Is Nothing And Not memoLigne Is R.Rows(1) Then memoLigne.RowHeight = 50
    Cells(ActiveCell.Row, 1).Select
        Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 4)).Select
    With Selection.Font
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
    End With
    Cells(ActiveCell.Row, 1).Select
        Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 8)).Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Cells(ActiveCell.Row, 1).Select
    Set memoLigne = R.Rows(1)

    memoLigne.RowHeight = 300
        Cells(ActiveCell.Row, 1).Select
        Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 13)).Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
        Cells(ActiveCell.Row, 1).Select
        ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    ActiveWindow.ScrollRow = Selection.Row

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
end sub

C'est la partie ci-dessous qui ne fonctionne pas :
Code:
If Not memoLigne Is Nothing And Not memoLigne Is R.Rows(1) Then memoLigne.RowHeight = 50
    Cells(ActiveCell.Row, 1).Select
        Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 4)).Select
    With Selection.Font
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
    End With
    Cells(ActiveCell.Row, 1).Select
        Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 8)).Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Cells(ActiveCell.Row, 1).Select
    Set memoLigne = R.Rows(1)

Je ne vois pas comment faire.
Si tu peux encore m'apporter ton aide.
Merci à toi,
Amicalement,
Arthour973
 
Dernière édition:
à regarder vite fait car je dois m'absenter.
Le If Not memoLigne Is Nothing And Not memoLigne Is R.Rows(1) Then memoLigne.RowHeight = 50 est un If en 1 ligne.
Il faut le transformer en IF sur plusieurs lignes si tu as d'autres actions à faire :
If Not memoLigne Is Nothing And Not memoLigne Is R.Rows(1) Then
memoLigne.RowHeight = 50
' et puis ceci...
' et cela...
endif
 
Bon Eriic, le forum,

Merci de m'avoir répondu à nouveau.
J'ai regardé et ça fonctionne.
Super Merci.

Il m'est apparu une autre question mais différente en complément.
Je faire faire un nouveau post.
Bonne journée à toutes et à tous,
Amicalement,
Arthour973
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
14
Affichages
252
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
513
Réponses
2
Affichages
160
Retour