Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres Utiliser un Array

Calvus

XLDnaute Barbatruc
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
 

Pièces jointes

  • Colorer Array.xlsm
    22.9 KB · Affichages: 14
Trier par date Trier par votes

Dranreb

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Paf

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif

Calvus

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
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, …
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Calvus

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • Calvus- Colorer Array- v1a.xlsm
    20.9 KB · Affichages: 11
Dernière édition:
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

en fait si avec plutot un select case true et des cases match
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

D
  • Question
XL 2019 Message diffèrent en fonction état booléens
Réponses
3
Affichages
561
darkjedi
D
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
502
un internaute
U
U
  • Question
Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement
Réponses
11
Affichages
639
un internaute
U
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
B
  • Résolu(e)
XL 2016 Modifier ou créer une macro imprimer une sélection de zones
Réponses
5
Affichages
654
berru76
B
U
  • Question
Autres [RESOLU] Application.ScreenUpdating = False
Réponses
4
Affichages
1 K
un internaute
U
M
  • Question
XL 2013 VBA-Envoyer par email "Plage de cellules collée dans un nouveau classeur en gardant formules de certaines cellules
Réponses
2
Affichages
853
MONTREAL2020
M
  • Résolu(e)
Microsoft 365 Calendrier : Modifier Target > change R
Réponses
10
Affichages
2 K
Usine à gaz
  • Résolu(e)
XL 2010 Dresser un Array à partir de plusieurs Arrays
Réponses
14
Affichages
1 K
Magic_Doctor
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…