Microsoft 365 Procédure trop longue

eric72 · 10 Juillet 2023

Bonsoir à tous,
J'ai un fichier pour gérer un planning dans lequel j'ai créer un code pour dupliquer la saisie sur la tranche horaire qui suit en double cliquant sur les cellules en rose, cela fonctionne bien mais uniquement pour le lundi et le mardi, si j'ajoute les autres jours il me dit que la procédure est trop longue, le souci c'est que je dois le faire sur les 6 jours.
L'un d'entre vous a-t-il une idée sur ce sujet.
Merci beaucoup pour votre dévouement.
Eric

TooFatBoy · 11 Juillet 2023

Sous réserve de m'être trompé, on doit pouvoir simplifier un peu plus.

On aurait toujours la macro paramétrée :

VB:

Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13...

TooFatBoy · 11 Juillet 2023

eric72 à dit:
En effet, par contre quelle est l'astuce pour ne pas que cela fonctionne si on double click sur e14?

TooFatBoy à dit:
Ensuite on suit exactement le même raisonnement pour les colonnes.

eric72 · 11 Juillet 2023

Merci beaucoup pour tout, au cas ou j'ai crée un autre post pour mon second problème (sans vouloir abuser).
Bonne soirée

TooFatBoy · 12 Juillet 2023

TooFatBoy à dit:
Je vais essayer de trouver un PC, pour t'envoyer une version plus simple, dans la journée.

Voici la version "plus simple" dont je parlais.

Elle consiste juste à revenir en arrière pour revenir à une seule macro :

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    With Target

        ' Vérification de la validité de la ligne
        If ((.Row Mod 7) <> 0) Or (.Row > 448) Or ((((.Row / 7) - 1) Mod 8) = 0) Then Exit Sub

        ' Vérification de la validité de la colonne
        If (((.Column + 8) Mod 12) <> 0) Or (.Column > 64) Then Exit Sub

        Cancel = True

        Application.ScreenUpdating = False

        ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14

    End With

End Sub

Microsoft 365 Procédure trop longue

eric72

XLDnaute Accro

Pièces jointes

TooFatBoy

TooFatBoy

XLDnaute Barbatruc

eric72

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

Discussions similaires