Actualisation de la page avec un textbox

Bonjour à tous,

J'ai crée un calendrier qui est basé sur les 52 semaines de l'année. J'ai différentes macro qui me permettent de naviguer à l'horizontal pour changer le jour de la semaine (lundi, mardi, mercredi, etc. de la semaine X) ou à la vertical pour changer de semaine.

Ainsi pour aller de jour en jour, on clique sur les boutons "LU ; MA ; ME ; JE ; etc. " et pour changer de semaine en clique sur les flèches à côté de la textbox en haut pour avancer (flèche de droite) ou reculer (flèche de gauche).

Ma question maintenant est : est-il possible de rentrer le numéro de la semaine qu'on veut dans la textbox et une fois "enter", cela nous achemine directement sur la semaine indiquée, au lieu de devoir appuyé x fois sur les flèches "suivant" ou "précédent" pour arriver sur la semaine voulue.

Exemple : on se trouve actuellement sur la semaine 1 et je veux aller directement à la semaine 35 juste en indiquant 35 dans la textbox ou je suis sur la semaine 35 et je veux aller à la semaine 1, etc.

Si jamais les colonnes A-D sont cachées normalement!

J'ai mis, ci-joint, le fichier, mais pour une question de taille, il n'y a que 2 semaines au lieu de 52 car c'est trop lourd. D'ailleurs, y a-t-il un moyen d'alléger mon fichier ou non, car avec 52 semaines soit 416 tableaux d'environ 8 colonnes et 60 lignes, il fait plus d'1 Mo!

Merci d'avance,

Viox

30calendrier.xlsm (293.28 Ko)

Bonjour,

utilise l'évènement TextBox1_Change()

Comme ta mise à jour est un peu lente ne la lance que si tu as 2 caractères et saisis 02 au lieu de 2.

Pour accélérer et éviter les clignotements ajoute screenupdating=false au début des maj.

eric

Hello Eric et merci pour ta réponse!

Ma macro a l'air de marcher pas trop mal, par contre, j'ai encore un problème dont je n'arrive pas à résoudre :

Une fois arrivé à la semaine 52, si je veux manuellement repartir en arrière via la textbox cela ne marche pas. Les flèches oui!

Voici ma macro:

Private Sub TextBox1_Change()

semaine = TextBox1.Text

If Len(semaine) = 2 Then
    If semaine > Range("A1").Value And Range("A1").Value < 52 Then
        Application.ScreenUpdating = False
        ActiveWindow.FreezePanes = False
        Rows("4:2915").EntireRow.Hidden = True

        debut = Range("C3") + 56 * (semaine - Range("A1").Value)
        fin = Range("D3") + 56 * (semaine - Range("A1").Value)

        Rows(debut & ":" & fin).EntireRow.Hidden = False

        Range("K" & debut + 2).Select
        ActiveWindow.FreezePanes = True
        ActiveSheet.ScrollArea = "$K:$R"

        Range("C3") = debut
        Range("D3") = fin
        Range("A1") = semaine

        Application.ScreenUpdating = True

    ElseIf semaine < Range("A1").Value And Range("A1").Value > 1 Then
        Application.ScreenUpdating = False
        ActiveWindow.FreezePanes = False
        Rows("4:2915").EntireRow.Hidden = True

        debut = Range("C3") - 56 * (Range("A1").Value - semaine)
        fin = Range("D3") - 56 * (Range("A1").Value - semaine)

        Rows(debut & ":" & fin).EntireRow.Hidden = False

        Range("K" & debut + 2).Select
        ActiveWindow.FreezePanes = True
        ActiveSheet.ScrollArea = "$K:$R"

        Range("C3") = debut
        Range("D3") = fin
        Range("A1") = semaine

        Application.ScreenUpdating = True

    End If
End If
End Sub

C'est dommage, c'est celui qui devrait marcher.

Tu ne dois avoir qu'une seule mise à jour, tes flèches doivent seulement modifier le textbox.

Sans fichier je ne regarde pas plus...

eric

Hello Eric,

J'ai bien compris ta réponse! J'ai essayé de faire les macros suivantes :

Sub suivant()

semaine = TextBox1.Value + 1

If Len(semaine) = 1 Then
    TextBox1.Text = "0" & semaine
Else
    TextBox1.Text = semaine
End If

End Sub

ou

Sub precedent()

semaine = TextBox1.Value - 1

If Len(semaine) = 1 Then
    TextBox1.Text = "0" & semaine
Else
    TextBox1.Text = semaine
End If

End Sub

Mais cela ne marche pas vraiment. je te remet le fichier, ci-joint, que j'ai dû raccourcir à 10 semaines, mais j'ai mis en conséquence les macros et tu verras que si tu vas à la dixième semaine, il est ensuite impossible de revenir en arrière en changeant la textbox ou via les flèches. Je t'ai mis les précédentes macros des flèches (en commentaires) qui, elles, marchaient par contre.

Merci d'avance,

Viox

12calendrier.xlsm (215.16 Ko)

Il faut typer semaine : Dim semaine As Long.

Sinon il prend la chaine "01" que tu compares à A1 qui est un nombre dans If semaine > Range("A1").Value, ce qui n'a pas de sens.

Je t'ai simplifié Suivant et Précédent aussi, en limitant l'amplitude de 1 à 53.

eric

16calendrier.xlsm (215.44 Ko)

Hello Eric,

Merci d'avoir pris le temps de faire cette modification, mais j'ai toujours un petit problème.

En effet, lorsque que je veux inscrire dans la textbox un chiffre en dizaine, il va aller directement à la semaine de mon premier chiffre inscrit (exemple : je veux 35 et il va à 03 soit la semaine 3).

J'arrive de temps à autre à inscrire un chiffre en dizaine, mais faut être super rapide et là, soit ça marche, soit il ne se dirige pas à la semaine voulue et reste à l'écran sur la semaine précédente, mais lorsque qu'on bouge les flèches, il va à la semaine suivante ou précédente de celle précédemment voulue (exemple: je suis sur la semaine 2 et je veux aller à la 35, j'arrive à taper 35 dans la textbox mais il reste sur la semaine 1 à l'écran et lorsque je clique sur la flèche suivante, il met à l'écran la semaine 36).

Je sais pas s'il est donc possible de faire quelque chose, dans tous les cas merci pour le reste,¨

Viox

Bonjour,

Je formatais un peu trop tôt à 2 caractères (dans Suivant et Précédent), et il faut déplacer ton test If Len(TextBox1) = 2 Then

Et tu dois pouvoir simplifier TextBox1_Change() en évitant le test If semaine > Range("A1") then ... Else ... Endif

Si ton nombre de lignes est constant pour chaque semaine, tu dois calculer debut et fin à partir de semaine. Et sans utiliser A1, C3 et D3.

eric

23calendrier.xlsm (217.96 Ko)

Merci Eric,

Je crois que c'est tout bon maintenant. On formatait en effet trop tôt dans la procédure Textbox1_change(). Par contre, tu dis que tu formatais trop tôt dans les deux caractères (Suivant et Précédent), mais si on enlève le formatage, cela ne marchais plus alors je les ai qu'en même remis et ça marche très bien avec.

Sub suivant()
    TextBox1 = Format(Application.Min(TextBox1.Value + 1, 52), "00")
End Sub

Et

Sub precedent()
    TextBox1 = Format(Application.Max(TextBox1.Value - 1, 1), "00")
End Sub

Pour finir, j'ai suivi ton conseil et j'ai supprimé la condition If en remplaçant debut et fin par semaine et ça marche bien.

Voilà le code finale:

Private Sub TextBox1_Change()

Dim semaine As Long
    If Len(TextBox1) = 2 Then
        TextBox1.Text = Format(Application.Min(Application.Max(TextBox1.Value, 1), 52), "00")
        semaine = TextBox1.Text
        Application.ScreenUpdating = False
        ActiveWindow.FreezePanes = False
        Rows("4:2915").EntireRow.Hidden = True

        debut = 4 + (56 * (semaine - 1))
        fin = 59 + (56 * (semaine - 1))

        Rows(debut & ":" & fin).EntireRow.Hidden = False

        Range("K" & debut + 2).Select
        ActiveWindow.FreezePanes = True
        ActiveSheet.ScrollArea = "$K:$R"
        Range("A1") = semaine
        Range("A3") = "K"
        Range("B3") = "Q"
        Range("C3") = debut
        Range("D3") = fin

        Application.ScreenUpdating = True

    End If
End Sub

Merci beaucoup Eric pour ton aide précieuse. A la prochaine,

Viox

Je vois que tu as re-limité les semaines à 52.

Dans le système de semaine ISO (Européen) tu peux avoir 53 semaines (2015 par exemple)...

Nombre de semaines ISO dans l'année :

=52+(JOURSEM("28/12/"&F4;2)<4)

ce qui donne en vba :

semMax = 52 - (Weekday(CDate("28/12/" & annee), 2) < 4)

eric

En effet, merci Eric, mais je travaille normalement tout le temps avec 52 semaines, mais j'ai qu'en même rajouté une semaine de plus car je pense que je vais changer ma manière de faire.

Merci bien pour ton aide!

Viox

Rechercher des sujets similaires à "actualisation page textbox"