barre de défilement (controle de formulaire)

Kasa

XLDnaute Nouveau
Bonjour :),


Cela fait plusieurs jours que je galère à faire une barre de défilement sur Excel.

Je m'explique:

J’ai un fichier sur lequel je suis des outillages et leurs dates régulièrement.

Je souhaite pouvoir naviguer en gardant les raccourcis (entourés en rouge) en permanence présents sur la fenêtre.
aide excel.png


J’ai essayé tout d’abord de bêtement figer les volets mais ça ne fonctionnais pas comme je le voulais (la fenêtre était coupée au milieu en croix). Puis je me suis renseigner et maintenant j'essaye de faire une barre de défilement afin de ne faire bouger que les colonnes (entourée en bleu), en regardant différentes pages sur les forums j'ai vus que cela était possible mais je n'ai pas réussi à l'adapter à mon cas (j'ai mis en valeur mini 2, malheur max 2500, cellule liée k48) et j'ai rentré la macro mais cela n'as pas fonctionné du tout.



Je vous demande donc si quelqu'un aurait la solution à mon problème


Merci d'avance.

Kasa :)
 

Pièces jointes

  • inventaire caisses, caisse n°17-Divers, caisse déplacement noire .xlsx
    229.1 KB · Affichages: 13
Solution
Dans ce fichier (2) la macro Deplacer est mise dans le module standard Module1 :
VB:
Public lig&, t# 'mémorise les variables

Sub Deplacer()
If ActiveWorkbook.Name = ThisWorkbook.Name And LCase(ActiveSheet.Name) = "inventaire caisses" Then
    If ActiveWindow.ScrollRow <> lig Then
        Dim col%, cc%
        col = [MonTableau].Column
        cc = [MonTableau].Columns.Count
        Application.ScreenUpdating = False
        [MonTableau].Cut [MonTableau].Offset(, cc) 'couper-coller vers la droite
        lig = ActiveWindow.ScrollRow 'mémorise la ligne
        [MonTableau].Cut Cells(lig, col) 'couper-coller vers la gauche
        Application.ScreenUpdating = True
    End If
End If
On Error Resume Next
Application.OnTime t, "Deplacer", , False 'RAZ
t = Now + 1 / 86400...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Une autre solution mais qui oblige à recréer une feuille :

Par contre cet outil n'aime pas les cellules fusionnées. Mais cela peut être une piste.

Si vous retrouver le site qui arrive à faire ça, pouvez vous m'envoyer le lien juste par curiosité. J'aimerais essayer car je ne connais pas.
 

job75

XLDnaute Barbatruc
Bonsoir Kasa, sylvanu,

Voyez le fichier joint et ce code dans ThisWorkbook :
VB:
Dim lig&, t# 'mémorise les variables

Private Sub Workbook_Open()
Deplacer 'lance la macro
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime t, "'" & Me.Name & "'!" & Me.CodeName & ".Deplacer", , False 'RAZ
End Sub

Sub Deplacer()
If ActiveWorkbook.Name = Me.Name And LCase(ActiveSheet.Name) = "inventaire caisses" Then
    If ActiveWindow.ScrollRow <> lig Then
        Dim col%, cc%, adr$
        col = [MonTableau].Column
        cc = [MonTableau].Columns.Count
        Application.ScreenUpdating = False
        [MonTableau].Cut [MonTableau].Offset(, cc) 'couper-coller vers la droite
        adr = [MonTableau].Address
        With [MonTableau].Offset(, -cc)
            .Interior.Color = RGB(128, 128, 128) 'gris foncé
            .Borders.Weight = xlThin
        End With
        lig = ActiveWindow.ScrollRow 'mémorise la ligne
        [MonTableau].Cut Cells(lig, col) 'couper-coller vers la gauche
        With Range(adr)
            .Interior.Color = RGB(128, 128, 128) 'gris foncé
            .Borders.Weight = xlThin
        End With
        Application.ScreenUpdating = True
    End If
End If
On Error Resume Next
Application.OnTime t, "'" & Me.Name & "'!" & Me.CodeName & ".Deplacer", , False 'RAZ
t = Now + 1 / 86400 'temporisation 1 seconde
Application.OnTime t, "'" & Me.Name & "'!" & Me.CodeName & ".Deplacer"
End Sub
La plage qui est coupée-collée est nommée MonTableau.

Le couper-coller a lieu quand on utilise la barre de défilement verticale.

Nota 1 : le processus reste actif même avec d'autres feuilles actives ou fichiers actifs.

Nota 2 : on ne peut pas éviter le clignotement des Info-bulles des liens hypertextes.

Nota 3 : les formules des cellules en vert ne paraissent pas correctes.

A+
 

Pièces jointes

  • inventaire(1).xlsm
    252.6 KB · Affichages: 6
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Kasa, le forum,

Les cellules de la zone des couper-coller sont dotées d'un style (ombré, bordures).

Il est donc inutile de remettre en forme les zones coupées, fichier (1 bis) avec :
VB:
Sub Deplacer()
If ActiveWorkbook.Name = Me.Name And LCase(ActiveSheet.Name) = "inventaire caisses" Then
    If ActiveWindow.ScrollRow <> lig Then
        Dim col%, cc%
        col = [MonTableau].Column
        cc = [MonTableau].Columns.Count
        Application.ScreenUpdating = False
        [MonTableau].Cut [MonTableau].Offset(, cc) 'couper-coller vers la droite
        lig = ActiveWindow.ScrollRow 'mémorise la ligne
        [MonTableau].Cut Cells(lig, col) 'couper-coller vers la gauche
        Application.ScreenUpdating = True
    End If
End If
On Error Resume Next
Application.OnTime t, "'" & Me.Name & "'!" & Me.CodeName & ".Deplacer", , False 'RAZ
t = Now + 1 / 86400 'temporisation 1 seconde
Application.OnTime t, "'" & Me.Name & "'!" & Me.CodeName & ".Deplacer"
End Sub
Bonne journée.
 

Pièces jointes

  • inventaire(1 bis).xlsm
    246.1 KB · Affichages: 7

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à @Kasa, @sylvanu , @job75

J'avais commencé quelque chose mais la nuit m'a l’intercepté sur ma lancée. Je publie malgré le codage à la va-vite.

La fenêtre des liens apparait quand on sélectionne la la feuille "inventaire caisses" (sauf si on vient de la feuille lien :confused:).
 

Pièces jointes

  • Kasa- Fenêtrage- v1.xlsm
    247.9 KB · Affichages: 10
Dernière édition:

job75

XLDnaute Barbatruc
Dans ce fichier (2) la macro Deplacer est mise dans le module standard Module1 :
VB:
Public lig&, t# 'mémorise les variables

Sub Deplacer()
If ActiveWorkbook.Name = ThisWorkbook.Name And LCase(ActiveSheet.Name) = "inventaire caisses" Then
    If ActiveWindow.ScrollRow <> lig Then
        Dim col%, cc%
        col = [MonTableau].Column
        cc = [MonTableau].Columns.Count
        Application.ScreenUpdating = False
        [MonTableau].Cut [MonTableau].Offset(, cc) 'couper-coller vers la droite
        lig = ActiveWindow.ScrollRow 'mémorise la ligne
        [MonTableau].Cut Cells(lig, col) 'couper-coller vers la gauche
        Application.ScreenUpdating = True
    End If
End If
On Error Resume Next
Application.OnTime t, "Deplacer", , False 'RAZ
t = Now + 1 / 86400 'temporisation 1 seconde
Application.OnTime t, "Deplacer"
End Sub
Bonjour mapomme.
 

Pièces jointes

  • inventaire(2).xlsm
    246.5 KB · Affichages: 12

Kasa

XLDnaute Nouveau
@job75 j'ai essayé tes fichiers, le (1) et (2) ont l'air de convenir parfaitement, respect c'est impressionnant OO merci beaucoup.


Pour le 1 bis je n'ai pas compris, il n'as pas l'air de fonctionner, ou alors c'est moi qui fait une fausse manipulation ce qui est beaucoup plus probable je pense ^^


@mapomme merci de ton aide mais je ne peux pas ouvrir ton fichier il est corrompu ^^

Je vais essayer de mettre tout en place l'undi, @job75 @sylvanu @mapomme je vous remercie énormément pour ce que vous avez fait :)


Je vais essayer aussi de comprendre le détail de se que vous avez fait afin d’apprendre et de pouvoir me débrouiller par moi-même pour la suite ou expliquer a quelqu’un.



Merci encore
 

Discussions similaires