Autres Utiliser un Array

[Calvus]

Bonjour le forum,

Comment faire pour utiliser les valeurs d'Arrays déclarés dans une macro avec un Select Case ?

Par exemple ceci fonctionne :

Cadre1 = Array("01", "02", "03", "04")
            Select Case sh.Name
                Case "01", "02", "03", "04"

Mais si je fais appel au nom de l'Array, évidemment ça "bugue".

Cadre1 = Array("01", "02", "03", "04")
            Select Case sh.Name
                Case Cadre1

J'ai mis le code intégral dans le fichier exemple, dont le but est de colorer des groupes de shapes.
La 1ère macro fonctionne, appelant directement chaque cas
La 2nde plante pour les raisons invoquées plus haut.

Voici les 2 codes :

Sub Colorer()
Dim i As Integer, j As Integer, t, f As Worksheet, t1, f1 As Worksheet

Dim Cadre1, Cadre2, Cadre3

Cadre1 = Array("01", "02", "03", "04")
Cadre2 = Array("05", "06", "07", "08")
Cadre3 = Array("09", "10", "11", "12")

    Dim sh As Shape, couleur1, couleur2, couleur3, couleur4, couleur5
    couleur1 = RGB(180, 196, 100)
    couleur2 = RGB(180, 226, 120)
    couleur3 = RGB(140, 186, 160)
   
    For Each sh In ActiveSheet.Shapes
        If IsNumeric(sh.Name) Then
            Select Case sh.Name
                Case "01", "02", "03", "04"
                    sh.Fill.ForeColor.RGB = couleur1
                Case "05", "06", "07", "08"
                    sh.Fill.ForeColor.RGB = couleur2
                Case "09", "10", "11", "12"
                    sh.Fill.ForeColor.RGB = couleur3
            End Select
        End If
    Next sh
End Sub

Sub Colorer_2()
Dim i As Integer, j As Integer, t, f As Worksheet, t1, f1 As Worksheet

Dim Cadre1, Cadre2, Cadre3

Cadre1 = Array("01", "02", "03", "04")
Cadre2 = Array("05", "06", "07", "08")
Cadre3 = Array("09", "10", "11", "12")

    Dim sh As Shape, couleur1, couleur2, couleur3, couleur4, couleur5
    couleur1 = RGB(180, 196, 100)
    couleur2 = RGB(180, 226, 120)
    couleur3 = RGB(140, 186, 160)
   
    For Each sh In ActiveSheet.Shapes
        If IsNumeric(sh.Name) Then
            Select Case sh.Name
                Case Cadre1
                    sh.Fill.ForeColor.RGB = couleur1
                Case Cadre2
                    sh.Fill.ForeColor.RGB = couleur2
                Case Cadre3
                    sh.Fill.ForeColor.RGB = couleur3
            End Select
        End If
    Next sh
End Sub

J'aimerais évidemment utiliser le 2nd code.

Merci et bonne journée

 

[Calvus]

Re, bonjour Mapomme

@mapomme , @patricktoulon

Merci, vos méthodes fonctionnent bien.
Beau contournement du problème Patrick

Bonne journée et merci.

 

[patricktoulon]

le test isnumeric(sh.name) n'a plus de raison d’être bien entendu
et ça n'est pas un contournement c'est la seule façon de gérer la fonction match il ne peut en être autrement

 

[mapomme]

Re,

J'ai laissé trainé un ActiveSheet dans la dernière boucle qui n'a rien à y faire. J'ai corrigé.

 

[Paf]

Bonjour à tous,

Concernant la solution de Paf, ça plante également si on a des noms non numériques (malgré la mise en place d'une condition) ou ne figurant pas dans les arrays..

Que le nom du shape soit 1 ou 01 ou Truc, il sera considéré comme un string, je ne vois pas où il peut y avoir plantage ?

Et ça ne peut pas planter sur un shape qui ne figure pas dans un array, puisque s'il ne figure pas dans un array , il ne sera pas traité....?

Un soucis surviendrait si chaque array n'a pas le même nombre d'éléments...

 

[patricktoulon]

re
avec ma version il n'y a plus de soucis de nom numérique ou string ou existant ou pas ou de nombre d'item différent par cadre
le select case true teste tout les arrays et items avec iserror(match(sh.name,cadreX,0)) qui renvoie un booleen

 

[Calvus]

Re,

Un soucis surviendrait si chaque array n'a pas le même nombre d'éléments...

C'est le cas en effet.

 

[patricktoulon]

Re,



C'est le cas en effet.

ben avec ma méthode non

 

[job75]

Bonjour Calvus et les autres,

Il suffit de bien utiliser Select Case :

Sub Colorer()
Dim Cadre1, Cadre2, Cadre3, couleur1&, couleur2&, couleur3&, sh As Shape

Cadre1 = Array("01", "02", "03", "04")
Cadre2 = Array("05", "06", "07", "08")
Cadre3 = Array("09", "10", "11", "12")

couleur1 = RGB(180, 196, 100)
couleur2 = RGB(180, 226, 120)
couleur3 = RGB(140, 186, 160)
    
For Each sh In ActiveSheet.Shapes
    If IsNumeric(sh.Name) Then
        Select Case -IsNumeric(Application.Match(sh.Name, Cadre1, 0)) _
            - 2 * IsNumeric(Application.Match(sh.Name, Cadre2, 0)) _
                - 3 * IsNumeric(Application.Match(sh.Name, Cadre3, 0))
            Case 1: sh.Fill.ForeColor.RGB = couleur1
            Case 2: sh.Fill.ForeColor.RGB = couleur2
            Case 3: sh.Fill.ForeColor.RGB = couleur3
        End Select
    End If
Next sh
End Sub

A+

 

[job75]

Bien entendu Select Case est parfaitement inutile, voyez le code de ce fichier (2) :

Sub Colorer()
Dim Cadre1, Cadre2, Cadre3, couleur1&, couleur2&, couleur3&, sh As Shape

Cadre1 = Array("01", "02", "03", "04")
Cadre2 = Array("05", "06", "07", "08")
Cadre3 = Array("09", "10", "11", "12")

couleur1 = RGB(180, 196, 100)
couleur2 = RGB(180, 226, 120)
couleur3 = RGB(140, 186, 160)
    
For Each sh In ActiveSheet.Shapes
    If IsNumeric(sh.Name) Then _
        sh.Fill.ForeColor.RGB = -couleur1 * IsNumeric(Application.Match(sh.Name, Cadre1, 0)) _
            - couleur2 * IsNumeric(Application.Match(sh.Name, Cadre2, 0)) _
                - couleur3 * IsNumeric(Application.Match(sh.Name, Cadre3, 0))
Next sh
End Sub

 

[patricktoulon]

bonjour job75
ma version fait abstraction de
numeric ou pas c'est les noms dans les array qui priment et le nombre peut être différent d'un array a l'autre
pas si inutile que ca le selectcase true

Sub Colorer_3()
Dim i As Integer, j As Integer, t, f As Worksheet, t1, f1 As Worksheet

Dim Cadre1, Cadre2, Cadre3

Cadre1 = Array("01", "02", "03", "04", "toto", "riri")
Cadre2 = Array("05", "06", "07", "08", "fifi")
Cadre3 = Array("09", "10", "11", "12", "loulou", "pafpaf")

    Dim sh As Shape, couleur1, couleur2, couleur3, couleur4, couleur5
    couleur1 = RGB(180, 196, 100)
    couleur2 = RGB(180, 226, 120)
    couleur3 = RGB(140, 186, 160)

    For Each sh In ActiveSheet.Shapes
            Select Case True
                Case Not IsError(Application.Match(sh.Name, Cadre1, 0))
                    sh.Fill.ForeColor.RGB = couleur1
                Case Not IsError(Application.Match(sh.Name, Cadre2, 0))
                    sh.Fill.ForeColor.RGB = couleur2
                Case Not IsError(Application.Match(sh.Name, Cadre3, 0))
                    sh.Fill.ForeColor.RGB = couleur3
            End Select
        Next sh
End Sub

ca y est j'ai mal a la tete

 sh.Fill.ForeColor.RGB = -couleur1 * IsNumeric(Application.Match(sh.Name, Cadre1, 0)) _
            - couleur2 * IsNumeric(Application.Match(sh.Name, Cadre2, 0)) _
                - couleur3 * IsNumeric(Application.Match(sh.Name, Cadre3, 0))

 

[job75]

Oui c'est vrai que le Select Case True permet de gagner un peu de temps puisqu'on en sort dès que la valeur True est rencontrée.

 

[Calvus]

Bonsoir,

Merci de tes réponses Job75.

J'ai adapté mon fichier avec le code de Patricktoulon qui fonctionne bien en effet.

Bonne soirée.