Excel & VB - Motifs dans un rectangle

Fermé

ridertart Messages postés 14 Date d'inscription jeudi 27 décembre 2007 Statut Membre Dernière intervention 21 février 2008 - 13 févr. 2008 à 11:57
LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 - 11 mars 2008 à 15:08

Bonjour,

J'aurais souhaité avoir un conseil pour un programme Visual Basic sur Excel.

Voila :
Avec Visual je crée plusieurs rectangle sur ma feuille excel. Ces rectangles ont un remplissage blanc.

J'ai fais une sorte de nuancier en créant une 30 aine de petit rectangle avec un fond avec des couleurs et des motif particuliers.

Or je voudrais trouver une solution pour pouvoir choisir un remplissage de mes nouveaux rectangles crées avec VB à l'aide de ce "nuancier".

Je ne sais pas trop comment faire ... Je pensais à 2 solution :
1) Cliquer sur un des rectangle de mon nuancier et de le faire glisser vers mon nouveau rectangle afin que ce nouveau rectangle puisse obtenir la couleur du rectangle choisi dans mon nuancier ... Or ceci implique que le rectangle du nuancier à la suite de cette opération retourne à son emplacement dans le nuancier.

2) Créer un menu déroulant pour chaque rectangle à colorier (il y en aura 3 au maximum) montrant les motifs de mon nuancier. Ensuite le choix de cette couleur pourrait remplir automatiquement mon rectangle.

Pouvez vous m'indiquer quelle serait la meilleure solution ou la plus faisable afin de me donner des pistes pour continuer ?

Par contre je ne sais pas comment faire pour faire ce menu déroulant incluant les nuances ... ni comment utliser une manip de style Drag & Drop ...

Merci à tous.

A voir également:

Excel & VB - Motifs dans un rectangle
Liste déroulante excel - Guide
Formule excel - Guide
Vb cable - Télécharger - Audio & Musique
Si et excel - Guide
Aller à la ligne dans une cellule excel - Guide

2 réponses

Réponse 1 / 2

LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 337
8 mars 2008 à 15:22

Solution manuelle :
- clique sur le rectangle de la couleur à copier
- clique sur l'outil "Reproduire la mise en forme" (pinceau)
- clique sur ton rectangle à colorier

Solution macro :
Pour cet exemple, j'ai défini 3 rectangles modèles appelés : "Rectangle 1", "Rectangle 2", "Rectangle 3"
et j'ai ajouté un autre rectangle (celui que je veux colorier).
Sur ma feuille j'ai inscris dans la cellule adjacente à chaque rectangle modèle le N° correspondant (1, 2, 3)
Je sélectionne le rectangle à colorier et j'appelle la macro test (Alt + F8) et j'appuie sur "Exécuter"
J'indique dans la boîte de dialogue le N° du rectangle de la couleur à copier
Et voila le résulat.

Sub test()
On Error Resume Next
RectAcolorier = Selection.Name
If RectAcolorier = "" Then
MsgBox ("Sélectionnez le rectangle à colorier !")
Exit Sub
End If

myNum = Application.InputBox("Enter a number")
Rectangle = "Rectangle " & myNum
ActiveSheet.Shapes(Rectangle).Select
Selection.ShapeRange.PickUp

ActiveSheet.Shapes(RectAcolorier).Select
Selection.ShapeRange.Apply
End Sub

Réponse 2 / 2

LePierre Messages postés 249 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 2 août 2012 337
11 mars 2008 à 15:08

par rapport à ma réponse précédente, je crois avoir trouvé "la" solution !

Solution macro :
Pour cet exemple, j'ai défini 3 rectangles modèles auxquels est affectée la macro "RecopieCouleurs"
et j'ai ajouté un autre rectangle (celui que je veux colorier).
Je clique gauche sur un rectangle modèle
Je clique droit sur le rectangle à colorier et je choisi la commande "Coller la couleur du rectangle" du menu contextuel.
Et voila le résulat.

Sub RecopieCouleurs()
CouleurRectangle = Application.Caller
ActiveSheet.Shapes(CouleurRectangle).Select
Selection.ShapeRange.PickUp
End Sub

Sub CollerCouleurs()
Selection.ShapeRange.Apply
End Sub

Sub Auto_Open()
Dim Menu_Contextuel As CommandBar
Dim NewBtn As CommandBarComboBox
Dim NewBtn2 As CommandBarControl

Set Menu_Contextuel = Application.CommandBars("Shapes")
'trait séparateur
Menu_Contextuel.Controls.Add(before:=1).BeginGroup = True
'Ajout menu
Set NewBtn2 = Menu_Contextuel.Controls.Add(Type:=msoControlButton, before:=1)
With NewBtn2
.Caption = "Coller la couleur du rectangle"
.BeginGroup = True
.OnAction = "CollerCouleurs"
End With
'effacement ligne vide
Menu_Contextuel.Controls.Item(2).Delete
End Sub

Sub Auto_Close()
Application.CommandBars("Shapes").Reset
End Sub

Discussions similaires

smyley rectangulaire

Discussions similaires

Newsletters