For each avec cellules sélectionnées Ctrl+clic

Le 06/10/2020 à 16:39

Bonjour,

Voila je voudrais savoir comment appliquer une macro qui se lance l'une après l'autre (peu importe l'ordre). Ci-dessous un exemple simplifié. Je voudrais que la macro applique le code une case après l'autre et pas tout en même temps. Il me semble qu'un for each est le plus adapté mais je ne maîtrise pas. J'aurais donc besoin de l'initialisation du code ainsi que la fin (Next ???)

Merci

image image image
Le 06/10/2020 à 20:49

Bonsoir,

je ne comprend pas...

@ bientôt

LouReeD

Le 07/10/2020 à 07:51

Bonjour,

Quelque chose qui ressemblerait à ça :

Sub Test2()
Dim c As Range
For Each c In Range("A1:H10")
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next
End Sub

Mais je voudrais juste appliquer le code simplement aux cellules sélectionnées sur la plage A10:H10

Le 07/10/2020 à 08:41

Dim cellule As Range
For Each cellule In Selection

.........Code.........

Next cellule

genre ça, mais ça marche pas :'(

Le 07/10/2020 à 10:36

Bonjour Yonik, LouReeD,

En retour le code ci-dessous.

Sub Kolor()
'Les cellules à colorier devront être sélectionnés avant
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535 '  Raz par xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Attention, ne pas appliquer si aucune cellule en sélection. Sinon c'est toute la feuille que tu vas colorier.

Le 07/10/2020 à 11:15

Ce n'est pas ça, le code est plus compliqué que ça. La première boucle marche mais pas la deuxième. Chaque sélection doit s'effectuer l'une après l'autre en gardant en mémoire les sélections initiales. Le problème c'est qu'au cours de la première macro, les sélections sont changées.

Sub liquides()

Application.ScreenUpdating = False

ActiveCell.Copy

    Workbooks.Open Filename:= _
        "P:\Magasin\Commun\Ordonnancement\Saison 2020\Ordres de fabrication\OF Conditionneuses.xlsm"
        Sheets("OF ESCALQUENS").Activate
        Range("C6").Select

        ActiveSheet.Paste
        Range("T6:V6").Value = "LIQUIDES"
 '---------------------------- destination ----------------------------
        Windows("Planning").Activate
        ActiveCell.Offset(0, 2).Select

                        If ActiveCell.Value = "PAL" Then

                        Windows("OF Conditionneuses").Activate
                        Sheets("OF ESCALQUENS").Activate

                        Range("T11:V11").Value = "PALETTE BOIS"
                        End If

                         If ActiveCell.Value = "BOX" Then

                        Windows("OF Conditionneuses").Activate
                        Sheets("OF ESCALQUENS").Activate

                        Range("T11:V11").Value = "BOX PLASTIQUE"
                        End If
                        If ActiveCell.Value = "UN" Then

                        Windows("OF Conditionneuses").Activate
                        Sheets("OF ESCALQUENS").Activate

                        Range("T11:V11").Value = "UNITE"
                        End If
'---------------------------- l'unité ----------------------------

    Windows("Planning").Activate
        ActiveCell.Offset(0, -1).Select
        Selection.Copy
        Windows("OF Conditionneuses").Activate
        Sheets("OF ESCALQUENS").Activate
        Range("C11").Select
        ActiveSheet.Paste
            With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
'---------------------------- la quantité ----------------------------

    Application.Run "'OF Conditionneuses.xlsm'!extract"
'---------------------------- extract des composants ----------------------------
    Range("U10:V10").Select
    ActiveCell.FormulaR1C1 = "=R[1]C[-18]*R[34]C[-15]"
'---------------------------- nombre bidons ----------------------------
Windows("Planning").Activate
Do While ActiveCell.Value < 3000
ActiveCell.Offset(-1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
Selection.Copy
Windows("OF Conditionneuses").Activate
Sheets("OF ESCALQUENS").Activate
Range("S12").Select
ActiveSheet.Paste
    Range("S12:V12").Select
    Selection.NumberFormat = "m/d/yyyy"
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    Application.Run "'OF Conditionneuses.xlsm'!Bouton1807_Cliquer"
'---------------------------- date ----------------------------
    Windows("OF Conditionneuses.xlsm").Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
'---------------------------- ferme ----------------------------

End Sub
Le 07/10/2020 à 11:31

Bonjour,

je pars de l'exemple réduit :

Dim c As Range
For Each c In Selection
    With c.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next

eric

PS : et si tu veux mémoriser ta sélection au départ :

Dim pl As Range
Set pl = Selection

et il faut se passer de tous les .Select inutiles (soit 99%). Et si possible ne pas travailler avec ActiveCell

Par exemple, ne pas écrire :

        c.Offset(0, 2).Select
        With ActiveCell
            '...
        End With

mais :

        With c.Offset(0, 2)
            '...
        End With
Le 07/10/2020 à 13:20

Merci de ta réponse mais je ne pense pas pouvoir l'exploiter correctement :/
Tu aurais moyen de m'expliquer ça : Dim pl As Range Set pl = Selection ? je l'ai mis au début mais le pb persiste :/

Ainsi que la bonne façon d'écrire "activecell". Je comprendrais mieux avec un exemple ^^

Le 07/10/2020 à 15:14

Le problème c'est que tu voudrais programmer sans avoir acquis les bases.
Donc forcément même les réponses te paraissent obscures.
Quant à mettre un exemple pour ActiveCell il me semble que c'est ce que j'ai fait.

Donc laisse tomber la fin de mon post et concentre-toi sur le 1er code jusqu'à ce que tu le comprennes.
Et prend le temps de parcourir et d'assimiler ça : https://www.excel-pratique.com/fr/formation
eric

Le 07/10/2020 à 16:52

A nouveau,

Ce n'est pas ça, le code est plus compliqué que ça. La première boucle marche mais pas la deuxième.

La macro Kolor est à rappeler chaque fois que tu changes de groupe de cellules sélectionnées.

Si en 1ière boucle c'est B1, C2, D1 qui est en sélection alors faire une Call Kolor pour que le code colore ta sélection.

Si en 2ième boucle c'est B2, C3, D2 qui se trouve en sélection alors faire de nouveau appel par Call Kolor pour colorer cette sélection. Etc....

Chaque fois que tu as un groupe de cellules sélectionnées tu appliques ainsi la couleur. Une fois que celles ci sont teintes il n' y a pas besoin qu'elles restent en sélection.

C'est du travail à la chaine... Comme chez F..D quand ils colorent les autos.

Le 07/10/2020 à 19:51

Bonsoir …

Il est difficile de trouver une réponse valable sans le contexte. Je ne me suis pas casser la tête à essayer de comprendre le code ci-dessus donc, pour changer la couleur par cellule, je prendrai plutôt une évènementielle* Voilà un exemple de codage avec une plage A10 : H10 , quelques cellules de cette plage concernées par le changement (ici Interior-fond car plus visuel que Font-police pour les contenus Truc, Chose, Machin) et même un roulement sur 3 couleurs ; Dans la fenêtre des codes de la feuille en jeu :

Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If Not Intersect(R, [A10:H10]) Is Nothing And R.CountLarge = 1 Then
    If R = "Truc" Or R = "Chose" Or R = "Machin" Then
     Select Case R.Interior.Color 'plus visuel que Font.Color
       Case vbWhite: R.Interior.Color = vbYellow
       Case vbYellow: R.Interior.Color = vbRed
       Case vbRed: R.Interior.Color = vbWhite
    End Select
    End If
    [B10].Select 'une des cellules non concernée pour établir une rotation
  End If
End sub

*choix des cellules en premier comme l’a suggéré X cellus .

Nota : pour éviter les surcharges, l’encadrement n’est pas traité ici.

Rechercher des sujets similaires à "each selectionnees ctrl clic"