Autres Utiliser un Array

Calvus · 31 Août 2019

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 :

VB:

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".

Code:

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 :

Code:

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

Code:

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

Dranreb · 31 Août 2019

Bonjour.
Dans la mesure où les noms de Shape sont numériques et se suivent par groupes de 4, j'utiliserais leur valeur numérique :

VB:

Sub Colorer()
   Dim Sh As Shape
   For Each Sh In ActiveSheet.Shapes
      If IsNumeric(Sh.Name) Then Sh.Fill.ForeColor.RGB = Choose((Sh.Name - 1) _
         / 4 + 1, RGB(180, 196, 100), RGB(180, 226, 120), RGB(140, 186, 160))
      Next Sh
   End Sub

Calvus · 31 Août 2019

Bonjour Dranreb,

Dranreb à dit:
Dans la mesure où les noms de Shape sont numériques et se suive,t par groupes de 4,

Non ce n'est pas le cas. J'ai mis ça pour l'exemple, mais mon fichier original comporte plus de 400 shapes et pas forcément numériques.

A+

Dranreb · 31 Août 2019

Vous pouvez utiliser la WorksheetFunction.Match alors pour trouver la position du nom dans une liste, et utiliser celle-ci à sa place.

Paf · 31 Août 2019

Bonjour Calvus, Dranreb,

une autre version qui conserve les arrays, plus faciles à modifier en cas de besoin

VB:

Sub Colorer()
Dim i As Integer, j As Integer, t, f As Worksheet, t1, f1 As Worksheet
Dim sh As Shape, couleur1, couleur2, couleur3, couleur4, couleur5
Dim Cadre1, Cadre2, Cadre3

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)

With ActiveSheet
For i = 0 To 3
   . Shapes(Cadre1(i)).Fill.ForeColor.RGB = couleur1
   . Shapes(Cadre2(i)).Fill.ForeColor.RGB = couleur2
    .Shapes(Cadre3(i)).Fill.ForeColor.RGB = couleur3
Next
End With

End Sub

A+

Calvus · 31 Août 2019

Bonjour Paf, Dranreb,

Concernant la proposition de Dranreb, ça plante. Je n'ai pas dû trouver la bonne formule.
Voici le code

VB:

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 Application.Match(sh.Name, Cadre1, 0)
                    sh.Fill.ForeColor.RGB = couleur1
                Case Application.Match(sh.Name, Cadre2, 0)
                    sh.Fill.ForeColor.RGB = couleur2
                Case Application.Match(sh.Name, Cadre3, 0)
                    sh.Fill.ForeColor.RGB = couleur3
            End Select
        End If
    Next sh
End Sub

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..

Merci

Dranreb · 31 Août 2019

Pourquoi donnez vous un exemple de Shape avec noms numériques alors que dans votre application ils ne le sont pas ?
Mettez dans un un seul Array tous les noms, groupés par couleurs.
Faites Position = WorksheetFunction.Match(Sh.Name, LeTableauCommun, 0) puis Select Case Position et derrière des Case 1 To 4, puis Case 5 To 8 etc. Ou si ce sont toujours des groupes de 4 vous pouvez faire comme j'avais dit en prenant Choose((Position - 1) \ 4 + 1, …

Calvus · 31 Août 2019

Re,

Ok, merci.

Bonne journée.

patricktoulon · 31 Août 2019

bonjour
comme les nom se suivent numériquement parlant et par groupe de 4 dans cadre....... ben tu n'a pas besoins de cadre

VB:

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

'Dim Cadre(1 To 3)

'Cadre(1) = "01,02,03,04"
'Cadre(2) = "05,06,07,08"
'Cadre(3) = "09,10,11,12"
    Dim sh As Shape, couleur(1 to 3)
    couleur(1) = RGB(180, 196, 100)
    couleur(2) = RGB(180, 226, 120)
    couleur(3) = RGB(140, 186, 160)
 
    For Each sh In ActiveSheet.Shapes
        If IsNumeric(sh.Name) Then
           Debug.Print sh.Name & "  " & "couleur" & Application.RoundUp(Val(sh.Name) / 4, 0)
                        sh.Fill.ForeColor.RGB = couleur(Application.RoundUp(Val(sh.Name) / 4, 0))
        End If
    Next sh
End Sub

Calvus · 31 Août 2019

Bonjour Patricktoulon,

Bon... merci mais j'ai fait une bêtise en mettant cet exemple. Je n'ai pas voulu mettre le code uniquement, j'ai donc fait un exemple à la va vite, voulant simplifier, sans penser que ça vous induirait tous en erreur, ma question initiale étant de vouloir savoir si on pouvait "lister" les valeurs de mes arrays.
Manifestement ce n'est pas possible.

Mon fichier original comporte plus de 400 shapes comme je l'ai dit, dont une centaine de numériques et qui ne se suivent pas, ainsi que 15 arrays.
Je n'aurais pas dû ouvrir ce fil, et vais continuer à utiliser ma méthode.

Désolé d'avoir eu à vous déranger pour rien.

Bonne journée.

Dranreb · 31 Août 2019

Remarque: avec 100 couleurs différentes vous pourriez avoir intérêt à les calculer à l'aide de mon objet Couleur.
Et encore, ce sera difficile d'en trouver plus de 50 qui ne se ressemblent pas trop !
Le module de classe Couleur qui définit cet objet est dans cette ressource.

Calvus · 31 Août 2019

Re,

Non, mes couleurs sont au nombre de 5 seulement.
La correspondance se fait dans les 15 cas différents, et je peux donc avoir plusieurs arrays colorés de la même façcon.

mapomme · 31 Août 2019

Bonjour à tous,

Une autre méthode par mapomme en utilisant une feuille "Param". Pas besoin de code RGB, on colore directement la cellule de la ligne 1 de la couleur désirée des formes. Sous la cellule colorée, on indique les formes concernées. les modifications sont simplissimes que ce soit de couleur ou de formes rattachées à une couleur. On peut ajouter ou supprimer des groupes facilement. pas besoin de connaître de nombre de cadrei et couleuri à l'avance pour écrire le code. Le code reste fixe.

VB:

Sub Colorer()
Dim i&, j&, t, dico, xrg As Range, xcol, xcell, coul, shp

  With Sheets("Param")
    Set dico = CreateObject("scripting.dictionary")
    dico.CompareMode = TextCompare
    t = .Range("a1").CurrentRegion
    For j = 2 To UBound(t, 2)
      coul = .Cells(1, j).Interior.Color
      For i = 2 To UBound(t)
        If t(i, j) <> "" Then dico(CStr(t(i, j))) = coul
      Next i
    Next j
  End With

  Application.ScreenUpdating = False
  With Sheets("Feuil1")
    For Each shp In .Shapes: shp.Fill.ForeColor.RGB = dico(CStr(shp.Name)): Next
    .Activate
  End With
End Sub

patricktoulon · 31 Août 2019

Calvus à dit:
Bonjour Patricktoulon,

Bon... merci mais j'ai fait une bêtise en mettant cet exemple. Je n'ai pas voulu mettre le code uniquement, j'ai donc fait un exemple à la va vite, voulant simplifier, sans penser que ça vous induirait tous en erreur, ma question initiale étant de vouloir savoir si on pouvait "lister" les valeurs de mes arrays.
Manifestement ce n'est pas possible.

Mon fichier original comporte plus de 400 shapes comme je l'ai dit, dont une centaine de numériques et qui ne se suivent pas, ainsi que 15 arrays.
Je n'aurais pas dû ouvrir ce fil, et vais continuer à utiliser ma méthode.

Désolé d'avoir eu à vous déranger pour rien.

Bonne journée.

en fait si avec plutot un select case true et des cases match

patricktoulon · 31 Août 2019

re
ton post#6 corrigé
match n'a pas de catch il faut donc gérer l'erreur pour les not match et ca se passe dans un selectcase TRUE
cette methode te permet de gerer des noms no numerique et aussi un nombre diferent de nom dans chaque cadre

VB:

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")
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 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
        End If
    Next sh
End Sub

explication

VB:

'si le match est négatif ca plante
Case Application.Match(sh.Name, Cadre1, 0)
                    sh.Fill.ForeColor.RGB = couleur1

VB:

'si le match est negatif ca ne fait rien (ce qu'est sensé faire un select case )
Case Not IsError(Application.Match(sh.Name, Cadre1, 0))

                    sh.Fill.ForeColor.RGB = couleur1

le"iserror(.......) gere en meme temps les erreur de catch non gér"s par match et transforme la valeur en booleene
conclusion selectcase true

Effectuez une recherche sur Excel Downloads...

Autres Utiliser un Array

Calvus

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums