Lister les motifs dans une plage

Le 12/08/22 Í  14:37, rmill...@gmail.com a écrit :

Bonjour,

Serait-il possible de connaitre tous les motifs (pattern) d'une plage?

For each pattern in UsedRange.patterns ... quelque chose du genre.

Car aussi

Workbooks(Var_NomXLForms).Sheets(Var_Sheet).Application.FindFormat.Clear
Workbooks(1).Sheets(1).Application.FindFormat.Interior.ColorIndex = 15

ne peut être ... <> 15

Auriez-vous des idées? Merci Í  l'avance.

Bonjour,

Pour éviter l'usage de la feuille "pattern" du classeur,
il y a cette macro :

Attention aux coupures de ligne de code inopportun par le service de
messagerie.

'-------------------------------------------------
Sub Identifier_LesCellules_Et_LeurPattern()

Dim Arr(), Arr1(), Elt As Variant, Adresse As String
Dim Rg As Range, C As Range, Sh As Worksheet
Dim LeCellFormat As CellFormat, A As Long, Adr As String
Dim X As Variant, F As Variant

Application.EnableEvents = False
Application.ScreenUpdating = False

'Listes des paterns disponibles dans Excel
'Tu dois apprendre cela par coeur ;-)
Arr = Array(xlPatternAutomatic, xlPatternChecker, xlPatternCrissCross, _
xlPatternDown, xlPatternGray16, xlPatternGray25,
xlPatternGray50, _
xlPatternGray75, xlPatternGray8, xlPatternGrid,
xlPatternHorizontal, _
xlPatternLightDown, xlPatternLightHorizontal,
xlPatternLightUp, _
xlPatternLightVertical, xlPatternLinearGradient,
xlPatternNone, _
xlPatternRectangularGradient, xlPatternSemiGray75,
xlPatternSolid, _
xlPatternUp, xlPatternVertical)

Arr1 = Array("xlPatternAutomatic", "xlPatternChecker",
"xlPatternCrissCross", _
"xlPatternDown", "xlPatternGray16", "xlPatternGray25",
"xlPatternGray50", _
"xlPatternGray75", "xlPatternGray8", "xlPatternGrid",
"xlPatternHorizontal", _
"xlPatternLightDown", "xlPatternLightHorizontal",
"xlPatternLightUp", _
"xlPatternLightVertical", "xlPatternLinearGradient",
"xlPatternNone", _
"xlPatternRectangularGradient", "xlPatternSemiGray75",
"xlPatternSolid", _
"xlPatternUp", "xlPatternVertical")

'Détermine la plage de cellules o͹ s'effectue
'la recherche
With Worksheets("Feuil1") 'Nom de la feuille Í  définir
'si tu veux faire la recherche dans toute la feuille
Set Rg = .UsedRange
'Pour limiter la recherche Í  une colonne particulière
'Set Rg = .Range("A:A")
End With

'LÍ  o͹ sera affiché le résultat
Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh.Range("A1") = "Patrern des cellules"
Sh.Range("B1") = "Adresse des cellules ayant ce pattern"

Set LeCellFormat = Application.FindFormat

A = 1
For Each Elt In Arr
'Détermine les caractéristiques
'du format de cellule recherché.
With LeCellFormat
.Clear 'S'assurer d'effacer les critères
'des anciennes recherches
.Interior.Pattern = Elt
End With

'Trouve la cellule ayant le bon format pour
'y effectuer une ou des opérations quelconques...
With Rg
Set C = .Find(What:="", SearchFormat:=True)
If Not C Is Nothing Then
Adr = C.Address
Do
Adresse = Adresse & "," & C.Address(0, 0)
'pour passer Í  la cellule suivante ...
Set C = .Find(What:="", after:=C, SearchFormat:=True)
Loop Until C.Address = Adr

'pour retrouver la valeur texte de la constante3
X = Application.Match(Elt, Arr, 0)
F = Feuil2.Range("A" & X)
'Retourne la valeur texte des constante
Sh.Range("A1").Offset(A) = F

'Supprime la virgule avant l'adresse de la première cellule
'de la chaͮne et l'affiche dans la feuille
Sh.Range("B1").Offset(A) = Right(Adresse, Len(Adresse) - 1)
A = A + 1
Adresse = ""
End If
End With
Next
Sh.Range("A:A").EntireColumn.AutoFit
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'-------------------------------------------------

MichD

Oups, un petit oubli. À la procédure précédente,
modifie cette ligne de code :

'pour retrouver la valeur texte de la constante3
X = Application.Match(Elt, Arr, 0)

Par

'pour retrouver la valeur texte de la constante3
X = Application.Match(Elt, Arr, 0) + 1

MichD



Le 13/08/22 Í  06:27, MichD a écrit :

Le 12/08/22 Í  14:37, rmill...@gmail.com a écrit :

Bonjour,

Serait-il possible de connaitre tous les motifs (pattern) d'une plage?

For each pattern in UsedRange.patterns ... quelque chose du genre.

Car aussi

Workbooks(Var_NomXLForms).Sheets(Var_Sheet).Application.FindFormat.Clear
Workbooks(1).Sheets(1).Application.FindFormat.Interior.ColorIndex = 15

ne peut être ... <> 15

Auriez-vous des idées? Merci Í  l'avance.

Bonjour,

Pour éviter l'usage de la feuille "pattern" du classeur,
il y a cette macro :

Attention aux coupures de ligne de code inopportun par le service de
messagerie.

'-------------------------------------------------
Sub Identifier_LesCellules_Et_LeurPattern()

Dim Arr(), Arr1(), Elt As Variant, Adresse As String
Dim Rg As Range, C As Range, Sh As Worksheet
Dim LeCellFormat As CellFormat, A As Long, Adr As String
Dim X As Variant, F As Variant

Application.EnableEvents = False
Application.ScreenUpdating = False

'Listes des paterns disponibles dans Excel
'Tu dois apprendre cela par coeur ;-)
Arr = Array(xlPatternAutomatic, xlPatternChecker, xlPatternCrissCross, _
           xlPatternDown, xlPatternGray16, xlPatternGray25,
xlPatternGray50, _
           xlPatternGray75, xlPatternGray8, xlPatternGrid,
xlPatternHorizontal, _
           xlPatternLightDown, xlPatternLightHorizontal,
xlPatternLightUp, _
           xlPatternLightVertical, xlPatternLinearGradient,
xlPatternNone, _
           xlPatternRectangularGradient, xlPatternSemiGray75,
xlPatternSolid, _
           xlPatternUp, xlPatternVertical)

Arr1 = Array("xlPatternAutomatic", "xlPatternChecker",
"xlPatternCrissCross", _
           "xlPatternDown", "xlPatternGray16", "xlPatternGray25",
"xlPatternGray50", _
           "xlPatternGray75", "xlPatternGray8", "xlPatternGrid",
"xlPatternHorizontal", _
           "xlPatternLightDown", "xlPatternLightHorizontal",
"xlPatternLightUp", _
           "xlPatternLightVertical", "xlPatternLinearGradient",
"xlPatternNone", _
           "xlPatternRectangularGradient", "xlPatternSemiGray75",
"xlPatternSolid", _
           "xlPatternUp", "xlPatternVertical")

'Détermine la plage de cellules o͹ s'effectue
'la recherche
With Worksheets("Feuil1") 'Nom de la feuille Í  définir
    'si tu veux faire la recherche dans toute la feuille
    Set Rg = .UsedRange
    'Pour limiter la recherche Í  une colonne particulière
    'Set Rg = .Range("A:A")
End With

'LÍ  o͹ sera affiché le résultat
Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh.Range("A1") = "Patrern des cellules"
Sh.Range("B1") = "Adresse des cellules ayant ce pattern"

Set LeCellFormat = Application.FindFormat

A = 1
For Each Elt In Arr
    'Détermine les caractéristiques
    'du format de cellule recherché.
    With LeCellFormat
        .Clear 'S'assurer d'effacer les critères
           'des anciennes recherches
        .Interior.Pattern = Elt
    End With

    'Trouve la cellule ayant le bon format pour
    'y effectuer une ou des opérations quelconques...
    With Rg
        Set C = .Find(What:="", SearchFormat:=True)
        If Not C Is Nothing Then
            Adr = C.Address
            Do
                Adresse = Adresse & "," & C.Address(0, 0)
                'pour passer ͠ la cellule suivante ...
                Set C = .Find(What:="", after:=C, SearchFormat:=True)
            Loop Until C.Address = Adr

            'pour retrouver la valeur texte de la constante3
            X = Application.Match(Elt, Arr, 0)
            F = Feuil2.Range("A" & X)
            'Retourne la valeur texte des constante
            Sh.Range("A1").Offset(A) = F

            'Supprime la virgule avant l'adresse de la première cellule
            'de la chaͮne et l'affiche dans la feuille
            Sh.Range("B1").Offset(A) = Right(Adresse, Len(Adresse) - 1)
            A = A + 1
            Adresse = ""
        End If
    End With
Next
Sh.Range("A:A").EntireColumn.AutoFit
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'-------------------------------------------------

MichD

Super et merci.