Microsoft 365 Bloquer défilement de la feuille selon hauteur de ligne

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite une beau dimanche

J'en ai une petite pour ce dimanche lol

Je cherche à bloquer le défilement de la feuille (haut/bas - droite/gauche) si une ligne est à hauteur 200.
Par exemple :
Si clic sur la ligne 10, elle se met en hauteur 200 et passe en 1ère ligne visible.
Je souhaite qu'on ne puisse pas bouger l'affichage de cette ligne qui doit rester en 1ère ligne visible.

Il y a bien ce fil : https://www.excel-downloads.com/threads/figer-defilement-feuille-excel.215646/
mais ce n'était pas suffisant.

Pour l'instant je n'ai pas trouvé comment le coder mais je continue ) tester et à chercher.
Auriez-vous le bon code ?
Je joins un p'tit fichier test

Remerciements du dimanche
lionel,

 

[job75]

Merci Gérard
Mais ça ne fonctionne pas
lionel

Tu veux envoyer les touches Ctrl+B non ?

C'est ce que fait CreateObject("wscript.shell").SendKeys "^b"

Teste un peu mieux

 

[Usine à gaz]

Re-Gérard,
"CreateObject("wscript.shell").SendKeys "^b""
J'ai testé mais ça ne fonctionne pas

 

[job75]

Bien sûr que ça fonctionne.

Tu as testé en faisant quoi ? Dépose ton fichier.

Bien sûr il faut avoir créé le raccourci clavier sur la macro.

 

[Usine à gaz]

Désolé, j'y comprends rien car maintenant ça fonctionne :

Private Sub Worksheet_SelectionChange(ByVal r As Range)
    If Not Intersect(activecell, Range("a2:zz20000")) Is Nothing Then
        If r.RowHeight = 18 Then
        Application.EnableEvents = False
        activecell.RowHeight = 150
        ActiveWindow.ScrollRow = Selection.Row
        CreateObject("wscript.shell").SendKeys "^b"
        'ActiveSheet.ScrollArea = ActiveWindow.VisibleRange.Address
       [a1].Select
        Application.EnableEvents = True
        Else
        Application.EnableEvents = False
        r.RowHeight = 18
        ActiveSheet.ScrollArea = ""
        [a1].Select
        Application.EnableEvents = True
        End If
    End If
End Sub

 

[job75]

Ton code me donne le tournis.

Pour lancer la macro Bloquer utilise plutôt :

Application.OnTime 1, "Bloquer"

c'est mieux que d'envoyer les touches Ctrl+B.

 

[job75]

Et pourquoi multiplier les Application.EnableEvents qui ne servent à rien ? Ce code suffit :

Private Sub Worksheet_SelectionChange(ByVal r As Range)
    If Intersect(ActiveCell, Range("a2:zz20000")) Is Nothing Then Exit Sub
    If r.RowHeight = 18 Then
        ActiveCell.RowHeight = 150
        Application.OnTime 1, "Bloquer"
    Else
        r.RowHeight = 18
        ActiveSheet.ScrollArea = ""
    End If
End Sub

Bonne nuit.

 

[Usine à gaz]

Et pourquoi multiplier les Application.EnableEvents qui ne servent à rien ? Ce code suffit :

Private Sub Worksheet_SelectionChange(ByVal r As Range)
    If Intersect(ActiveCell, Range("a2:zz20000")) Is Nothing Then Exit Sub
    If r.RowHeight = 18 Then
        ActiveCell.RowHeight = 150
        Application.OnTime 1, "Bloquer"
    Else
        r.RowHeight = 18
        ActiveSheet.ScrollArea = ""
    End If
End Sub

Bonne nuit.

Ha vraiment merci Gérard
Bonne nuit

 

[job75]

Bonjour Lionel, le forum,

Le fichier joint est quand même plus cohérent :

Private Sub Worksheet_SelectionChange(ByVal r As Range)
If r.Row = 1 Then Exit Sub
Application.ScreenUpdating = True
r.RowHeight = 150
Application.Goto Cells(r.Row, 1), True
Me.ScrollArea = Cells(r.Row, 1).Address 'bloque la sélection
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal r As Range, Cancel As Boolean)
If r.RowHeight = 150 Then Cancel = True: r.RowHeight = 18: Me.ScrollArea = "": [A1].Select
End Sub

A+

 

[Usine à gaz]

Bonjour Gérard
Bonjour à toutes et à tous

Merci Gérard vraiment d'une telle rigueur
Mais lol, j'allais demander une p'tite amélioration mais je ne sais pas si c'est possible :
Le ScrollArea bloque tout et c'est très bien mais j'aurais besoin de garder la possibilité de cliquer uniquement dans la ligne active qui "du coup" éviterait le clic droit qui est interdit (bloqué) dans mon "usine à gaz" .... est-ce possible ?

lol
lionel,

 

[job75]

Le clic droit est une bonne solution mais ceci va bien aussi :

Private Sub Worksheet_SelectionChange(ByVal r As Range)
If r.Row = 1 Then Exit Sub
If r.Column = 1 Then
    r.RowHeight = 150
    Application.Goto Cells(r.Row, 1), True
    Me.ScrollArea = Rows(r.Row).Address 'bloque la ligne
Else
    r.RowHeight = 18
    Me.ScrollArea = ""
End If
End Sub

 

[Usine à gaz]

Merci Gérard
Super nickel, je vais pouvoir l'intégrer dans mon volcan
lionel