XL 2013 Formater hauteur de ligne aller et retour

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

  • Test hauteur ligne aller et retour.xlsm
    18.1 KB · Affichages: 50

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re-Bonjour Eriic,

LOL l'affaire se corse :cool:

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:

eriiic

XLDnaute Barbatruc
à 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
 

Discussions similaires

Réponses
7
Affichages
369

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 305
Messages
2 087 084
Membres
103 459
dernier inscrit
Arnocal