XL 2016 liee deux macro

K

Keran

XLDnaute Junior
Bonjour :)
Je voulais savoir si je fais peux que ma vba

VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OS As Variant 'déclare le tableau des variables OS
Dim F As Worksheet 'déclare la variable F
Dim I As Byte 'déclare la variable I (Incrément)
Dim WS As Worksheet
Dim wss As Worksheet

    Application.ScreenUpdating = False
For Each WS In Sheets(Array("HJanvier", "HFevrier", "HMars", "HAvril", "HMai", "HJuin", _
                           "HJuillet", "HAout", "HSeptembre", "HOctobre", "HNovembre", "HDecembre", _
                           "BJanvier", "BFevrier", "BMars", "BAvril", "BMai", "BJuin", _
                           "BJuillet", "BAout", "BSeptembre", "BOctobre", "BNovembre", "BDecembre", _
                           "Bilan"))
                         
                    If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
                                               WS.Unprotect "azerty"
                                    WS.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
                                   
                                      WS.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
                       , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
                                             
                                             
End If
Next WS
    For Each wss In Sheets(Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", _
                           "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre"))
                         
                    If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
                                            wss.Unprotect "azerty"
                                    wss.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
                                    wss.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
                       , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
                                   
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim OS As Variant 'déclare le tableau des variables OS
Dim F As Worksheet 'déclare la variable F
Dim I As Byte 'déclare la variable I (Incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
'si la cellule double-cliquée se trouve dans une ligne inférieure à 6 ou supérieure à 65, sort de la procédure
If Target.Row < 6 Or Target.Row > 65 Then Exit Sub
'si la cellule double-cliquée se trouve dans une colonne inférieure à 9 ou supérieure à 16, sort de la procédure
If Target.Column < 9 Or Target.Column > 19 Then Exit Sub
Cancel = True 'annule le mode [Édition] lié au double-clic
Select Case Target.Column 'agit en fonction de la colonne double-cliquée
    Case 9 'cas 9 (=> colonne I)
        Set OS = Sheets(Array("HJanvier", "Janvier", "BJanvier")) 'définit le tableau des onglets OS
    Case 10 'cas 10 (=> colonne J)
        Set OS = Sheets(Array("HFevrier", "Fevrier", "BFevrier")) 'définit le tableau des onglets OS
    Case 11 'cas 11 (=> colonne K)
        Set OS = Sheets(Array("HMars", "Mars", "BMars")) 'définit le tableau des onglets OS
    Case 12 'cas 12 (=> colonne L)
        Set OS = Sheets(Array("HAvril", "Avril", "BAvril")) 'définit le tableau des onglets OS
    Case 13 'cas 13 (=> colonne M)
        Set OS = Sheets(Array("HMai", "Mai", "BMai")) 'définit le tableau des onglets OS
    Case 14 'cas 14 (=> colonne N)
        Set OS = Sheets(Array("HJuin", "Juin", "BJuin")) 'définit le tableau des onglets OS
    Case 15 'cas 15 (=> colonne O)
        Set OS = Sheets(Array("HJuillet", "Juillet", "BJuillet")) 'définit le tableau des onglets OS
    Case 16 'cas 16 (=> colonne P)
        Set OS = Sheets(Array("HAout", "Aout", "BAout")) 'définit le tableau des onglets OS
    Case 16 'cas 16 (=> colonne P)
        Set OS = Sheets(Array("HSetempbre", "Septembre", "BSeptembre")) 'définit le tableau des onglets OS
    Case 17 'cas 17 (=> colonne Q)
        Set OS = Sheets(Array("HOctobre", "Octobre", "BOctobre")) 'définit le tableau des onglets OS
    Case 18 'cas 18 (=> colonne R)
        Set OS = Sheets(Array("HNovembre", "Novembre", "BNovembre")) 'définit le tableau des onglets OS
    Case 19 'cas 19 (=> colonne S)
        Set OS = Sheets(Array("HDecembre", "Decembre", "BDecembre")) 'définit le tableau des onglets OS
End Select 'fin de l'action en fonction de la colonne double-cliquée
Target.Value = IIf(Target.Value = "X", "", "X") 'de'finit la valeur de la cellule double-cliquée (X si vide, vide si X)
For Each F In OS 'boucle sur tous les onglets du tableau des onglets OS
    If F.Range("A6") = "Jours" And F.Range("A8") = Range("X26") Then 'condition 1
        For I = 9 To 65 'boucle sur les ligne 9 à 65
            'si la condition est respectée masque la feuille si la cellule vaut X, sinon la ligne reste affichée
            If F.Range("A" & I) = Cells(Target.Row, 8).Value Then F.Rows(I).Hidden = Target.Value = "X"
        Next I 'prochaine ligne de la boucle
    End If 'fin de la condition
Next F 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub


                                             
                                             
End If
Next wss
Application.ScreenUpdating = True

puisse faire appel a cette vba apres c'est possible ?

VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim OS As Variant 'déclare le tableau des variables OS
Dim F As Worksheet 'déclare la variable F
Dim I As Byte 'déclare la variable I (Incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
'si la cellule double-cliquée se trouve dans une ligne inférieure à 6 ou supérieure à 65, sort de la procédure
If Target.Row < 6 Or Target.Row > 65 Then Exit Sub
'si la cellule double-cliquée se trouve dans une colonne inférieure à 9 ou supérieure à 16, sort de la procédure
If Target.Column < 9 Or Target.Column > 19 Then Exit Sub
Cancel = True 'annule le mode [Édition] lié au double-clic
Select Case Target.Column 'agit en fonction de la colonne double-cliquée
    Case 9 'cas 9 (=> colonne I)
        Set OS = Sheets(Array("HJanvier", "Janvier", "BJanvier")) 'définit le tableau des onglets OS
    Case 10 'cas 10 (=> colonne J)
        Set OS = Sheets(Array("HFevrier", "Fevrier", "BFevrier")) 'définit le tableau des onglets OS
    Case 11 'cas 11 (=> colonne K)
        Set OS = Sheets(Array("HMars", "Mars", "BMars")) 'définit le tableau des onglets OS
    Case 12 'cas 12 (=> colonne L)
        Set OS = Sheets(Array("HAvril", "Avril", "BAvril")) 'définit le tableau des onglets OS
    Case 13 'cas 13 (=> colonne M)
        Set OS = Sheets(Array("HMai", "Mai", "BMai")) 'définit le tableau des onglets OS
    Case 14 'cas 14 (=> colonne N)
        Set OS = Sheets(Array("HJuin", "Juin", "BJuin")) 'définit le tableau des onglets OS
    Case 15 'cas 15 (=> colonne O)
        Set OS = Sheets(Array("HJuillet", "Juillet", "BJuillet")) 'définit le tableau des onglets OS
    Case 16 'cas 16 (=> colonne P)
        Set OS = Sheets(Array("HAout", "Aout", "BAout")) 'définit le tableau des onglets OS
    Case 16 'cas 16 (=> colonne P)
        Set OS = Sheets(Array("HSetempbre", "Septembre", "BSeptembre")) 'définit le tableau des onglets OS
    Case 17 'cas 17 (=> colonne Q)
        Set OS = Sheets(Array("HOctobre", "Octobre", "BOctobre")) 'définit le tableau des onglets OS
    Case 18 'cas 18 (=> colonne R)
        Set OS = Sheets(Array("HNovembre", "Novembre", "BNovembre")) 'définit le tableau des onglets OS
    Case 19 'cas 19 (=> colonne S)
        Set OS = Sheets(Array("HDecembre", "Decembre", "BDecembre")) 'définit le tableau des onglets OS
End Select 'fin de l'action en fonction de la colonne double-cliquée
Target.Value = IIf(Target.Value = "X", "", "X") 'de'finit la valeur de la cellule double-cliquée (X si vide, vide si X)
For Each F In OS 'boucle sur tous les onglets du tableau des onglets OS
    If F.Range("A6") = "Jours" And F.Range("A8") = Range("X26") Then 'condition 1
        For I = 9 To 65 'boucle sur les ligne 9 à 65
            'si la condition est respectée masque la feuille si la cellule vaut X, sinon la ligne reste affichée
            If F.Range("A" & I) = Cells(Target.Row, 8).Value Then F.Rows(I).Hidden = Target.Value = "X"
        Next I 'prochaine ligne de la boucle
    End If 'fin de la condition
Next F 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

merci :)
 
Dernière édition:
Trier par date Trier par votes
K

Keran

XLDnaute Junior
pardon mauvais coller de macro les deux macro sont
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)

 Dim OS As Variant 'déclare le tableau des variables OS
 Dim F As Worksheet 'déclare la variable F
 Dim I As Byte 'déclare la variable I (Incrément)
 Dim WS As Worksheet
 Dim wss As Worksheet

 Application.ScreenUpdating = False
       For Each WS In Sheets(Array("HJanvier", "HFevrier", "HMars", "HAvril", "HMai", "HJuin", "HJuillet", "HAout", "HSeptembre", "HOctobre", _
         "HNovembre", "HDecembre", "BJanvier", "BFevrier", "BMars", "BAvril", "BMai", "BJuin", "BJuillet", "BAout", "BSeptembre", "BOctobre", _
         "BNovembre", "BDecembre", "Bilan"))
            If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
              WS.Unprotect "azerty"
              WS.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
              WS.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
              , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
            End If
       Next WS

       For Each wss In Sheets(Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", _
         "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre"))
            If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
              wss.Unprotect "azerty"
              wss.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
              wss.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
              , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
            End If
       Next wss
 Application.ScreenUpdating = True

 End Sub
qui devrais relancer ou du moins faire la meme chose as savoir que quand elle a fini elle doit masquer les ligne en x
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim OS As Variant 'déclare le tableau des variables OS

Dim F As Worksheet 'déclare la variable F

Dim I As Byte 'déclare la variable I (Incrément)


Application.ScreenUpdating = False 'masque les rafraîchissements d'écran

'si la cellule double-cliquée se trouve dans une ligne inférieure à 6 ou supérieure à 65, sort de la procédure

If Target.Row < 6 Or Target.Row > 65 Then Exit Sub

'si la cellule double-cliquée se trouve dans une colonne inférieure à 9 ou supérieure à 16, sort de la procédure

If Target.Column < 9 Or Target.Column > 19 Then Exit Sub

Cancel = True 'annule le mode [Édition] lié au double-clic

Select Case Target.Column 'agit en fonction de la colonne double-cliquée

    Case 9 'cas 9 (=> colonne I)

        Set OS = Sheets(Array("HJanvier", "Janvier", "BJanvier")) 'définit le tableau des onglets OS

    Case 10 'cas 10 (=> colonne J)

        Set OS = Sheets(Array("HFevrier", "Fevrier", "BFevrier")) 'définit le tableau des onglets OS

    Case 11 'cas 11 (=> colonne K)

        Set OS = Sheets(Array("HMars", "Mars", "BMars")) 'définit le tableau des onglets OS

    Case 12 'cas 12 (=> colonne L)

        Set OS = Sheets(Array("HAvril", "Avril", "BAvril")) 'définit le tableau des onglets OS

    Case 13 'cas 13 (=> colonne M)

        Set OS = Sheets(Array("HMai", "Mai", "BMai")) 'définit le tableau des onglets OS

    Case 14 'cas 14 (=> colonne N)

        Set OS = Sheets(Array("HJuin", "Juin", "BJuin")) 'définit le tableau des onglets OS

    Case 15 'cas 15 (=> colonne O)

        Set OS = Sheets(Array("HJuillet", "Juillet", "BJuillet")) 'définit le tableau des onglets OS

    Case 16 'cas 16 (=> colonne P)

        Set OS = Sheets(Array("HAout", "Aout", "BAout")) 'définit le tableau des onglets OS

    Case 16 'cas 16 (=> colonne P)

        Set OS = Sheets(Array("HSetempbre", "Septembre", "BSeptembre")) 'définit le tableau des onglets OS

    Case 17 'cas 17 (=> colonne Q)

        Set OS = Sheets(Array("HOctobre", "Octobre", "BOctobre")) 'définit le tableau des onglets OS

    Case 18 'cas 18 (=> colonne R)

        Set OS = Sheets(Array("HNovembre", "Novembre", "BNovembre")) 'définit le tableau des onglets OS

    Case 19 'cas 19 (=> colonne S)

        Set OS = Sheets(Array("HDecembre", "Decembre", "BDecembre")) 'définit le tableau des onglets OS

End Select 'fin de l'action en fonction de la colonne double-cliquée

Target.Value = IIf(Target.Value = "X", "", "X") 'de'finit la valeur de la cellule double-cliquée (X si vide, vide si X)

For Each F In OS 'boucle sur tous les onglets du tableau des onglets OS

    If F.Range("A6") = "Jours" And F.Range("A8") = Range("X26") Then 'condition 1

        For I = 9 To 65 'boucle sur les ligne 9 à 65

            'si la condition est respectée masque la feuille si la cellule vaut X, sinon la ligne reste affichée

            If F.Range("A" & I) = Cells(Target.Row, 8).Value Then F.Rows(I).Hidden = Target.Value = "X"

        Next I 'prochaine ligne de la boucle

    End If 'fin de la condition

Next F 'prochain onglet de la boucle

Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran

End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Microsoft 365 erreur d'execussion 6 - depassement de capacite
Réponses
2
Affichages
139
CARO13
C
G
  • Question
Microsoft 365 Enregistrer les onglets d'un fichier Excel séparément.
Réponses
2
Affichages
391
kiki29
kiki29
PORCHER
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
532
TooFatBoy
TooFatBoy
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
464
AtTheOne
AtTheOne
S
  • Question
XL 2021 macro VBA excel
Réponses
1
Affichages
371
crocrocro
C
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
406
guiyom
G
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
303
souhaib ad
S
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
473
laurent950
laurent950
N
  • Résolu(e)
Microsoft 365 Calcul de plages horaires
2 3 4
Réponses
49
Affichages
958
NONO14
N
R
  • Question
Microsoft 365 Copier des données d'un fichier à un autre en vérifiant si elles existent déjà
Réponses
1
Affichages
565
yal
Y

Membres actuellement en ligne

15 membres et 305 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 490
Messages
2 110 139
Membres
110 684
dernier inscrit
kihel