XL 2021 Sélection multiple cellules

[Did25]

Bonjour le Forum et bonjour à tous , j'ai repris un fichier fait en grande partie par l'aide d'XLD et que je souhaite modifier mais je rencontre un soucis et lorsque je souhaite sélectionner plusieurs cellules et que je veux les pointer avec le bouton congés cela ne fonctionne pas par contre cela fonctionne cellule par cellule . Merci de votre aide

 

[mromain]

Bonjour Did25,

Tu peux essayer en remplaçant le code de la procédure Inscription_Indisponibilites avec celui-ci :

Private Sub Inscription_Indisponibilites(Val_Indispo$)
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage écran
        .Calculation = xlCalculationManual 'désactivation du calcul automatique
        .EnableEvents = False 'désactivation des événements
    End With
    On Error GoTo Gere_Erreurs 'si erreur on réactive tout (ceinture et bretelles)
    For Compteur = 12 To 770 Step 3 'compte de la premiere colonne du tableau à la dernière par incrémentation de 3
        Dim curArea As Range
        For Each curArea In Selection.Areas
            If Compteur >= curArea.Resize(, 1).Column Then 'ne déclenche le code que si compteur supérieur ou égal à la première colonne de la sélection
                If curArea.Columns.Count + curArea.Resize(, 1).Column - 1 < Compteur Then Exit For 'sort de la boucle si compteur supérieur à la dernière colonne de la sélection
                Set Test_Plage = Nothing 'efface la référence
                Set Test_Plage = Intersect(Range("A4").Offset(0, Compteur - 1).Range("A1:A31"), curArea) 'récurère l'intersection sélection plage à modifier, reste à nothing si aucune
                If Not Test_Plage Is Nothing Then ' si plage d'intersectionb existe, exécute
                    For Each Cellule_en_Cours In Test_Plage 'pour chaque cellule de la plage d'intersection
                        With Cellule_en_Cours
                            If Not .Offset(0, -2).Value = "" And (.Offset(0, -1).Value = "A" Or .Offset(0, -1).Value = "M" Or .Offset(0, -1).Value = "N" Or .Offset(0, -1).Value = "AM" Or .Offset(0, -1).Value = "MA" Or .Offset(0, -1).Value = "AC") Then .FormulaR1C1 = Val_Indispo 'si valeur en même ligne, colonne -2 et service posté, applique la valeur
                        End With
                    Next Cellule_en_Cours
                End If
                Set Test_Plage = Nothing 'efface la référence (ceinture et bretelles)
            End If
        Next curArea
    Next Compteur
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage écran
        .Calculation = xlCalculationAutomatic 'activation du calcule automatique
        .EnableEvents = True 'activation des événements
    End With
End Sub

A+[/icode]

 

[Did25]

Bonjour mromain ,tout d'abord merci de votre intervention ,ça fonctionne presque je peux faire des sélections de quatre jours répartit un peu partout sur le mois de février par exemple mais que sur un mois en même temps pas sur des jours pointés un peu partout de janvier à décembre . Mais c'est déjà beaucoup mieux .

 

[mromain]

Bonjour Did25, le forum,

Bonjour mromain ,tout d'abord merci de votre intervention ,ça fonctionne presque je peux faire des sélections de quatre jours répartit un peu partout sur le mois de février par exemple mais que sur un mois en même temps pas sur des jours pointés un peu partout de janvier à décembre . Mais c'est déjà beaucoup mieux .

Normalement, le code ci-dessous devrait résoudre ce problème :

Private Sub Inscription_Indisponibilites(Val_Indispo$)
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage écran
        .Calculation = xlCalculationManual 'désactivation du calcul automatique
        .EnableEvents = False 'désactivation des événements
    End With
    On Error GoTo Gere_Erreurs 'si erreur on réactive tout (ceinture et bretelles)
    Dim curArea As Range
    For Each curArea In Selection.Areas
        For Compteur = 12 To 770 Step 3 'compte de la premiere colonne du tableau à la dernière par incrémentation de 3
            If Compteur >= curArea.Resize(, 1).Column Then 'ne déclenche le code que si compteur supérieur ou égal à la première colonne de la sélection
                If curArea.Columns.Count + curArea.Resize(, 1).Column - 1 < Compteur Then Exit For 'sort de la boucle si compteur supérieur à la dernière colonne de la sélection
                Set Test_Plage = Nothing 'efface la référence
                Set Test_Plage = Intersect(Range("A4").Offset(0, Compteur - 1).Range("A1:A31"), curArea) 'récurère l'intersection sélection plage à modifier, reste à nothing si aucune
                If Not Test_Plage Is Nothing Then ' si plage d'intersectionb existe, exécute
                    For Each Cellule_en_Cours In Test_Plage 'pour chaque cellule de la plage d'intersection
                        With Cellule_en_Cours
                            If Not .Offset(0, -2).Value = "" And (.Offset(0, -1).Value = "A" Or .Offset(0, -1).Value = "M" Or .Offset(0, -1).Value = "N" Or .Offset(0, -1).Value = "AM" Or .Offset(0, -1).Value = "MA" Or .Offset(0, -1).Value = "AC") Then .FormulaR1C1 = Val_Indispo 'si valeur en même ligne, colonne -2 et service posté, applique la valeur
                        End With
                    Next Cellule_en_Cours
                End If
                Set Test_Plage = Nothing 'efface la référence (ceinture et bretelles)
            End If
        Next Compteur
    Next curArea
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage écran
        .Calculation = xlCalculationAutomatic 'activation du calcule automatique
        .EnableEvents = True 'activation des événements
    End With
End Sub

A+

 

[Did25]

Bonjour et merci beaucoup pour votre travail je connaissais pas cette syntaxe "curArea.Resize" ,c'est parfait tout fonctionne très bien .Merci beaucoup ,bonnes fêtes de fin d'année .