Macro pour masquer des lignes dans différents onglets

Le 05/09/2020 à 11:13

Bonjour,

j'essaie en ce moment d'automatisé quelques tâches assez répétitives et barbantes sur un fichier que j'utilise au quotidien.

Ici, j'aimerai une macro pour masquer des lignes sur plusieurs onglets en fonction d'une valeur dans un onglet qui me sert de centre de contôle.

Je vous explique tout dans le fichier ci-joint.

Merci :)

4exemple.xlsx (30.25 Ko)
Le 05/09/2020 à 11:41

Bonjour,

Voici le principe avec peut-être quelques ajustements à faire.

Le premier code est à placer dans le module de feuille de "Training Plan". Le second est à placer dans un module normal :

'A PLACER DANS MODULE "Training Plan"

Private Sub worksheet_change(byval target as range)

if not intersect(target, range("F6")) is nothing then 'quand F6 change de valeur
    call OrganisationLignes() 'exécution macro OrganisationLignes
end if

end sub

'A PLACER DANS UN MODULE NORMAL

Sub OrganisationLignes()

Dim ws as Worksheet
Dim NbSessions as byte

NbSessions = Sheets("Training Plan").range("F6").value 'Renvoie valeur nb sessions en F6

for each ws in Worksheets 'sur chaque feuille du classeur
    if left(ws.name,4) = "Week" then 'si nom feuille commence par "week"
        select case NbSessions
        case 1 to 3 'cas nb sessions <= 3
            ws.rows.hidden = false 'affiche toutes les lignes masquées
            ws.range("13:17, 23:27").entirerow.hidden = true 'masque les lignes 13-17 et 23-27
        case 4 'cas nb sessions = 4
            ws.rows.hidden = false 'affiche tout
            ws.rows("18:22").hidden = true 'masque 18-22
        case else 'cas sinon (nb sessions >= 5)
            ws.rows.hidden = false 'affiche tout
        end select
    end if
next ws 'feuille suivante

msgbox "terminé !" 'message confirmation

end sub

En espérant que ça marchera directement.

Cordialement,

Le 05/09/2020 à 14:14

Alors j'ai essayé en l'adaptant à mon vrai fichier, cependant j'ai un message d'erreur qui dit "Erreur de compilation / Nom ambigu détecté : worsheet_change" pour le 1er code (celui à placer dans la feuille "Training Plan"), je pense que c'est du au fait que j'ai déja des lignes de code sur cette page et que je ne sais pas comment en intégrer de nouvelles, du coup je vous met les lignes de codes qui sont déjà présente pour que vous puissiez m'aider si vous voulez.

Option Explicit

Private Sub worksheet_change(ByVal target As Range)
Const LIGNES_TRAINING As String = "#56#88#120#152#184#216#248#280#312#344#376#408#440#472#504"
Const LIGNES_ANALYSIS As String = "#32#56#80#104#128#152#176#200#224#248#272#296#320#344#368"
Const TOTAL_TRAINING As String = "24:533"
Const TOTAL_ANALYSIS As String = "32:391"
If target.Address = "$M$16" Then
If IsNumeric(target.Value) Then
Masque_Affiche Sheets("Training Plan"), target, LIGNES_TRAINING, TOTAL_TRAINING
Masque_Affiche Sheets("Analysis"), target, LIGNES_ANALYSIS, TOTAL_ANALYSIS
End If
End If
End Sub

Private Sub Masque_Affiche(Feuil As Worksheet, Targ As Range, Lign As String, Tot As String)
Dim DL As String, Value As Integer
DL = ":" & Split(Tot, ":")(1)
Value = Targ.Value
With Feuil
.Rows(Tot).Hidden = False
If Value <= UBound(Split(Lign, "#")) And Value > 0 Then .Rows(Split(Lign, "#")(Value) & DL).Hidden = True
End With
End Sub

Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Range("N17")) Is Nothing Then
Call OrganisationLignes
End If
End Sub
Le 05/09/2020 à 14:33

Oui, il faut uniquement placer les lignes qui nous intéressent dans la procédure worksheetchange :

Option Explicit

Private Sub worksheet_change(ByVal target As Range)

Const LIGNES_TRAINING As String = "#56#88#120#152#184#216#248#280#312#344#376#408#440#472#504"
Const LIGNES_ANALYSIS As String = "#32#56#80#104#128#152#176#200#224#248#272#296#320#344#368"
Const TOTAL_TRAINING As String = "24:533"
Const TOTAL_ANALYSIS As String = "32:391"

If Not Intersect(target, Range("N17")) Is Nothing Then
    Call OrganisationLignes
End If

If target.Address = "$M$16" Then
    If IsNumeric(target.Value) Then
        Masque_Affiche Sheets("Training Plan"), target, LIGNES_TRAINING, TOTAL_TRAINING
        Masque_Affiche Sheets("Analysis"), target, LIGNES_ANALYSIS, TOTAL_ANALYSIS
    End If
End If

End Sub

Private Sub Masque_Affiche(Feuil As Worksheet, Targ As Range, Lign As String, Tot As String)

Dim DL As String, Value As Integer

DL = ":" & Split(Tot, ":")(1)
Value = Targ.Value

With Feuil
    .Rows(Tot).Hidden = False
    If Value <= UBound(Split(Lign, "#")) And Value > 0 Then .Rows(Split(Lign, "#")(Value) & DL).Hidden = True
End With

End Sub

Cordialement,

Le 05/09/2020 à 16:04

ça ne fonctionne pas, j'ai un message d'erreur de compilation encore une fois qui concerne la ligne "Call OrganisationLignes" et qui dit "Sub ou fonction non définie".

Donc j'ai

Autre chose, dans le module normal j'avais aussi quelques lignes de code, du coup j'ai intégré les vôtre comme tel :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Not Intersect(target, Range("$M$16")) Is Nothing Then
        For Each Sh In Worksheets
            Sh.Visible = True
            If Sh.Name Like "Week*" Then
                If Val(Right(Sh.Name, 2)) > target Then
                    Sh.Visible = False
                End If
            End If
        Next Sh
    End If
End Sub
Sub OrganisationLignes()

Dim ws As Worksheet
Dim NbSessions As Byte

NbSessions = Sheets("Training Plan").Range("N17").Value

For Each ws In Worksheets
    If Left(ws.Name, 4) = "Week" Then
        Select Case NbSessions
        Case 1 To 3
            ws.Rows.Hidden = False
            ws.Range("41:72, 105:136").EntireRow.Hidden = True
        Case 4
            ws.Rows.Hidden = False
            ws.Rows("73:104").Hidden = True
        Case Else
            ws.Rows.Hidden = False
        End Select
    End If
Next ws

MsgBox "terminé !"

Qu'en pensez vous?

Le 05/09/2020 à 16:24

Alors, je suis un peu perdu... Au cas où il y aurait un malentendu, un module normal n'est pas un module portant sur une feuille du classeur. Quand on est dans l'éditeur de code, il faut aller sur le menu Insertion/Module.

Puis, vous allez sur ce module et vous copiez :

Sub OrganisationLignes()

Dim ws as Worksheet
Dim NbSessions as byte

NbSessions = Sheets("Training Plan").range("F6").value 'Renvoie valeur nb sessions en F6

for each ws in Worksheets 'sur chaque feuille du classeur
    if left(ws.name,4) = "Week" then 'si nom feuille commence par "week"
        select case NbSessions
        case 1 to 3 'cas nb sessions <= 3
            ws.rows.hidden = false 'affiche toutes les lignes masquées
            ws.range("13:17, 23:27").entirerow.hidden = true 'masque les lignes 13-17 et 23-27
        case 4 'cas nb sessions = 4
            ws.rows.hidden = false 'affiche tout
            ws.rows("18:22").hidden = true 'masque 18-22
        case else 'cas sinon (nb sessions >= 5)
            ws.rows.hidden = false 'affiche tout
        end select
    end if
next ws 'feuille suivante

msgbox "terminé !" 'message confirmation

end sub

Là, nous avons la procédure qui nous intéresse réellement. Vous pouvez donc déjà essayer de la tester pour voir si elle fonctionne.

Ensuite, une fois que vous serez certain que l'organisation des lignes marche comme vous le souhaitiez, allez sur le module de la feuille "Training Plan" et ajoutez les lignes :

if not intersect(target, range("F6")) is nothing then 'quand F6 change de valeur
    call OrganisationLignes 'exécution macro OrganisationLignes
end if

au sein de votre macro évènementielle :

Private Sub worksheet_change(ByVal target As Range)
...
End sub

Là, vous pourrez tester si la macro OrganisationLignes (censée être fonctionnelle) se déclenche correctement, c'est-à-dire dès que la valeur de F6 change.

Le 05/09/2020 à 16:53

Aaah! Pour moi un module normal concernait la partie "ThisWorkbook". Du coup j'ai fais comme indiqué cependant au moment de sélectionner un certain nombre de sessions, un nouveau message d'erreur s'affiche qui dit : "Erreur d'éxecution 1004 : impossible de définir la propriété Hidden de la classe Range"...

Le 05/09/2020 à 16:54

D'accord, alors il faut remplacer le code par le suivant :

Sub OrganisationLignes()

Dim ws as Worksheet
Dim NbSessions as byte

NbSessions = Sheets("Training Plan").range("F6").value 'Renvoie valeur nb sessions en F6

for each ws in Worksheets 'sur chaque feuille du classeur
    if left(ws.name,4) = "Week" then 'si nom feuille commence par "week"
        select case NbSessions
        case 1 to 3 'cas nb sessions <= 3
            ws.rows.hidden = false 'affiche toutes les lignes masquées
            ws.rows("13:17").hidden = true
            ws.rows("23:27").hidden = true 'masque les lignes 13-17 et 23-27
        case 4 'cas nb sessions = 4
            ws.rows.hidden = false 'affiche tout
            ws.rows("18:22").hidden = true 'masque 18-22
        case else 'cas sinon (nb sessions >= 5)
            ws.rows.hidden = false 'affiche tout
        end select
    end if
next ws 'feuille suivante

msgbox "terminé !" 'message confirmation

end sub
Le 05/09/2020 à 17:00

Toujours le même message qui s'affiche, il semblerai que cela soit au niveau de

case 4 'cas nb sessions = 4
            ws.rows.hidden = false 'affiche tout

La 2ème ligne est surligné en jaune

Le 05/09/2020 à 17:11

Alors de mon côté, ça marche. Peut-être en essayant :

ws.rows.entirerow.hidden = false

Et en rajoutant le ".EntireRow" aux autres lignes.

Le 05/09/2020 à 17:37

Toujours pas de mon côté.. Pouvez vous m'envoyer votre fichier svp, pour que j'y jette un coup d’œil, je fais sûrement une fausse manip'

Merci et désolé du dérangement

Le 05/09/2020 à 17:43

En fait, je n'ai pas retouché votre fichier. J'ai juste fait un essai pour m'assurer que rows.hidden = false marchait.

Je vais voir directement sur votre fichier et je reviens vers vous.

Le 05/09/2020 à 17:50

Tout fonctionne très bien de mon côté !

Voici le fichier

9exemple.xlsm (43.11 Ko)
Le 05/09/2020 à 18:22

Merci, mais je ne comprends pas pourquoi je n'arrive pas à faire fonctionner ça sur mon vrai fichier (le fichier que j'ai mis en pièce jointe est seulement un exemple), je pense que c'est l'interaction avec d'autres lignes de code qui fait que cela ne fonctionne pas

je vous joint le vrai fichier si jamais vous pouvez y jeter un coup d’œil, j’espère ne pas trop vous déranger...

8test.zip (939.15 Ko)
Le 05/09/2020 à 20:26

Tout marche très bien ! Le petit problème, c'est que ton exemple était en F6 alors que dans ton fichier le nombre de sessions est en N17...

Je me suis permis de nommer les cellules M16 et N17 resp. NbWeeks et NbSessions.

J'espère que ça marchera chez toi.

Cordialement,

7test.zip (934.44 Ko)
Le 05/09/2020 à 21:34

Ok maintenant ça marche super bien, j'ai pu le transférer à mon vrai fichier (celui ci était une version alléger), et en fait ce qui bloquait c'est le fait que les page "Week" sont protéger avec un code, du coup en cochant "format de ligne" au moment de protéger les onglets ça fonctionne parfaitement!

En tout cas merci beaucoup à vous pour votre patience et votre aide :))

Le 05/09/2020 à 23:51

Et bah voilà .

Oui, j'ai également pensé à la protection quand tu m'as dit que ça bloquait toujours chez toi alors que ça marchait bien de mon côté.

Je suis content que ce soit résolu.

Bonne continuation !

Rechercher des sujets similaires à "macro masquer lignes differents onglets"