XL 2021 Macro dans Macro

[Constantin]

Bonjour à tous,
Dans le fichier joint, je m' intéresse surtout à deux macros :
- Grouper3()
- IdentifierPointsCollecte
Vous avez été nombreux à m'aider à réaliser cet utilitaire et je remercie ces contributeurs...

La macro Grouper3() permet de sélectionner les cellules de localisation qui m’intéressent dans la feuille "Plan"
La macro IdentifierPointsCollecte réalise le formatage des cellules du Plan en fonction des produits choisis dans "Sélection".
Pour l'heure, la sélection des cellules à formater s'effectue au moyen d'un "Range" qui ne contient pas moins de 20 tables du fait qu'une table ne peut contenir qu'un nombre fini d'éléments.

Je voudrais m'exonérer de ce "Range" (donc le remplacer par autre chose) en utilisant la sélection telle qu'on peut l'obtenir avec la macro Grouper3(). En gros, cela reviendrait à activer Grouper3() pour remplacer le contenu de ce "Range"... Je ne sais pas si c'est possible. J'essaye depuis plusieurs jours et je n'arrive à rien.
Si vous avez une idée...
Bien cordialement,
Pierre

 

[Dranreb]

Bonsoir.
Dans la mesure où la Sub Grouper3 se termine par P.Select, après l'avoir invoquée dans la Sub IdentifierPointsCollecte vous pourriez utiliser Selection.
Mais je préfèrerais écrire cette Sub Grouper3 sous forme de Function RngGroupe3() As Range.

Function RngGroupe3() As Range
   Dim Cel As Range
   For Each Cel In Worksheets("Plan").UsedRange.SpecialCells(xlCellTypeConstants)
      If IsNumeric(CStr(Cel.Value)) Or IsNumeric(Mid(Cel.Value, 2)) Then
         If RngGroupe3 Is Nothing Then Set RngGroupe3 = Cel.MergeArea Else Set RngGroupe3 = Union(RngGroupe3, Cel.MergeArea)
         End If
      Next Cel
   End Function

À tester …
Attention vous avez oublié le mot clé Set pour redéfinir P dans votre Sub Grouper3. Je suppose qu'elle ne marche donc pas en l'état.
Remarque: vous auriez peut être intérêt à définir deux styles de cellules personnalisés pour ces étiquettes.

 

[Constantin]

Bonjour Draneb,
Merci de votre réponse qui me semble très prometteuse. Mais mon niveau VBA rase les pâquerettes et je ne sais pas comment intégrer cette fonction dans mon code :
- Où dois-je l'enregistrer dans le VBAProjet ?
- Où dois-je la placer (l'insérer) dans le code de la macro IdentifierPointsCollecte pour remplacer ce "Range" à rallonge sans que cela ne bloque cette macro ? (je ne sais pas insérer une fonction dans une macro)

J'ai recherché sur le net des propositions mais je ne m'en sors pas.
Concernant la macro Grouper3, elle fonctionne bien et quand je la lance, elle affiche bien la sélection des cellules désirées sur le plan.
Je suppose qu'il faudrait appeler cette fonction à la place du Range ?
With Sheets("Plan").Range("t_A,t_B1,t_B2,t_B3,t_C1,t_C2,t_C3,t_D,t_E,t_F,t_H1,T_H2,t_J,t_K1,t_K2,t_L,t_M,t_V,t_X,t_Z")
Je vais essayer de trouver la réponse mais vos conseils en la matière me seraient très précieux...
Mille mercis,
A bientôt
Pierre

 

[Constantin]

Juste une question.
Je n'ai pas bien compris "vous auriez peut être intérêt à définir deux styles de cellules personnalisés pour ces étiquettes".
Le but de la macro est de modifier le style des cellules sélectionnées pour les faire apparaitre clairement sur le plan (fond jaune, police en rouge et gras). Pour tout vous dire, ce n'est pas moi qui a rédigé ce code, j'en aurai été incapable...
A l'origine, le Range concernait "Plan_magasin" et tous les formats (couleurs, polices) du plan étaient remis à "zéro" d'où l'idée de mes sélections de 20 tables dans le Range ce qui est plutôt lourd à gérer et à mettre à jour. Alors, toute simplification est forcément bienvenue !
So long!
Pierre

 

[Dranreb]

Boujour.
On ne peut pas en VBA définir de sous-procédure. On peut seulement en écrire d'autres à la suite de celles qui existent.
Mais dans toute procédure on peut y invoquer une autre Sub en mentionnant simplement son nom, éventuellement suivi des expressions valant les argument requis en paramètres éventuels.
Il me semble que si les cellules concernées avaient leur propriété Style renseignée elle pourraient être repérées plus simplement.

 

[Constantin]

Bonjour Draneb,
Oublions donc la possibilité de chaîner une macro à une autre. L'appel de la fonction RngGroupe3 semble pouvoir répondre à mon attente à savoir sélectionner les cellules contenant "lettres et chiffres" en amont des transformations (mises en forme) qu'elles vont subir. J'ai essayé de comprendre la syntaxe pour parvenir à intégrer cette fonction dans ma macro mais, n'ayant pas fait VBA 1ere langue, je rame...
J'essaye encore.
Encore merci pour vos suggestions.
Pierre

 

[Dranreb]

Créez donc deux styles "EtqNorm" et "EtqSurlgn" définissant seulement la police et la couleur de fond, puis attribuez le 1er aux cellules d'étiquettes.
Il devrait alors être possible de les repérer comme ça :

Sub IdentifierPointsCollecte()
   Dim ClnEtq As Collection, Cel As Range, T(), L As Long
   Set ClnEtq = New Collection
   For Each Cel In Feuil5.UsedRange
      If Cel.Style Like "Etq*" And Not IsEmpty(Cel.Value) Then
         ClnEtq.Add Item:=Cel, Key:=Cel.Value
         Cel.MergeArea.Style = "EtqNorm"
         End If: Next Cel
   T = [t_PointsCollecte].Value
   For L = 1 To UBound(T, 1)
      On Error Resume Next
      Set Cel = ClnEtq(T(L, 1))
      If Err = 0 Then Cel.MergeArea.Style = "EtqSurlgn"
      On Error GoTo 0
      Next L
   End Sub

 

[Constantin]

Re...
For Each Cel In Feuil5.UsedRange
Connait pas Feuil5...
J'ai essayé en lieu et place :
Plan puis "Plan" et enfin ("Plan")... Erreur de syntaxe.
Je vous envoie le fichier au cazou

 

[Dranreb]

C'était le nom de l'objet Worksheet représentant la feuille "Plan" dans la rubrique Microsoft Excel Objets du projet VBA de votre dernier classeur. Si vous tenez à consulter la collection Worksheets pour la trouver mettez Worksheets("Plan")
À première vue vous avez oublié de spécifier ce style aux étiquettes dans la feuille.

 

[Constantin]

J'ai remis dans le code "Feuil5". Quand je clique sur l’icône "Leclerc" dans Sélection, rien ne se passe sur le plan. (d'un autre côté, il n'y a plus de message d'erreur). J'ai ajouté un produit dans sélection et rien ne se passe et pourtant, j'ai bien créé les deux styles de cellules (EtqNorm et EtqSurlgn)...
Est-ce grave Docteur ?

 

[Dranreb]

Vous avez probablement oublié de spécifier ce style EtqNorm aux cellules concernées.
Attention: vous leur avez tout fait définir, or il y a des orientations diverses. J'avais dit seulement remplissage et police.

 

[Dranreb]

Lorsque vous aurez corrigé, ne cochant que Police et Remplissage, pour gagner du temps vous pouvez ajouter une instruction provisoire qui met le style automatiquement :

Sub IdentifierPointsCollecte()
   Dim ClnEtq As Collection, Cel As Range, T(), L As Long
   Set ClnEtq = New Collection
   For Each Cel In Feuil5.UsedRange
      If VarType(Cel.Value) = vbString And IsNumeric(Mid$(Cel.Value, 2)) Then Cel.MergeArea.Style = "EtqNorm"
      If Cel.Style Like "Etq*" And Not IsEmpty(Cel.Value) Then
         ClnEtq.Add Item:=Cel, Key:=Cel.Value
         Cel.MergeArea.Style = "EtqNorm"
         End If
      Next Cel
   T = [t_PointsCollecte].Value
   For L = 1 To UBound(T, 1)
      On Error Resume Next
      Set Cel = ClnEtq(T(L, 1))
      If Err = 0 Then Cel.Style = "EtqSurlgn"
      On Error GoTo 0
      Next L

 

[Dranreb]

Je ne vois pas où vous remplissez ce fameux t_PointsCollecte
Ne pourriez vous pas simplement prendre les t_ListeCourses[CHOIX (x)] non vides comme ça :

Sub IdentifierPointsCollecte()
   Dim ClnEtq As Collection, Cel As Range, L As Long
   Set ClnEtq = New Collection
   For Each Cel In Feuil5.UsedRange
 '     If VarType(Cel.Value) = vbString And IsNumeric(Mid$(Cel.Value, 2)) Then Cel.MergeArea.Style = "EtqNorm"
      If Cel.Style Like "Etq*" And Not IsEmpty(Cel.Value) Then
         ClnEtq.Add Item:=Cel, Key:=Cel.Value
         Cel.MergeArea.Style = "EtqNorm"
         End If
      Next Cel
   T = [t_ListeCourses[[CHOIX (x)]:[Localisation]]].Value
   For L = 1 To UBound(T, 1)
      If Not IsEmpty(T(L, 1)) Then
         On Error Resume Next
         Set Cel = ClnEtq(T(L, 2))
         If Err = 0 Then Cel.Style = "EtqSurlgn"
         On Error GoTo 0
         End If
      Next L
   End Sub

Il serait encore possible de prendre la VisibleRange du tableau filtré sur place. Attention il faut alors boucler sur ses Areas, qui sont des Range.

 

[Constantin]

C'est une excellente idée ! J'ai copié (remplacé) le code dans la macro mais malheureusement rien ne se passe.
Ça remet les cellules en style "EtqNorm" mais les choix "X" ne changent pas en mode "EtgSurlgn" les cellules du Plan faisant référence aux Localisations des cellules de "Sélection"...
Bon courage,
Pierre

 

[Dranreb]

À un moment j'avais une faute de frappe à "EtqSurlgn", le "q" y aillant été remplacé par un "g", que je retrouve dans votre poste. Alors vérifiez. Comment s'appelle votre style d'étiquette surlignée ? Parce que si ça commence par "Etg", forcément ça ne commence pas par "Etq" !