Selection qui ne se voit pas

**patricktoulon** · 17/04/2015, 16h41

re
je vais chercher le id du contour sachant que ces contrôles sont dans la xldialog ca pas être triste a chercher

re
en 2 seconde une macro de 10 lignes donne les barre et leur items(ctrols).id

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub listCMBS()
Cells.Clear
For Each cmb In Application.CommandBars
i = i + 1
Cells(1, i) = cmb.Name
e = 1
For Each Ctrl In cmb.Controls
e = e + 1
Cells(e, i) = Ctrl.ID
Next
 
Next
End Sub
'Fill Color

il semblerait que ca soit celle ci de part son nom

[FONT=Calibri]Fill Color[/FONT]

[FONT=Calibri]1453[/FONT]

[FONT=Calibri]1455[/FONT]

[FONT=Calibri]1456[/FONT]

[FONT=Calibri]1457[/FONT]

[FONT=Calibri]1051[/FONT]

[FONT=Calibri]1006[/FONT]

[FONT=Calibri]2668[/FONT]

re
j'ai amélioré la sub et j'obtiens les icons avec c'est maintenant une fonction
et il semblerait que plusieurs aient le même icones c'est peut être ce qui m'a induit en erreur
voila le code pour lister les commandbars et les id de chaque contrôles qu'elles contiennent
avec les icons c'est peut être un peu long mais le résultat est parlant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
'liste des commandbar
Sub liste()
listCMBS True 'on enleve le "true" si on veut pas les icons
End Sub
Function listCMBS(Optional ico = False)
Dim CmB, I, E
Cells.Clear
For Each CmB In Application.CommandBars
I = I + 1
Cells(1, I) = CmB.Name
E = 1
For Each Ctrl In CmB.Controls
E = E + 1
Cells(E, I) = Ctrl.ID
On Error Resume Next
If ico = True Then
With ActiveSheet
Ctrl.CopyFace
.Paste
.Shapes(.Shapes.Count).Left = .Cells(E, I).Left
.Shapes(.Shapes.Count).Top = .Cells(E, I).Top
End With
End If
On Error GoTo 0
Next
 
Next
End Function
'Fill Color

aperçu d'e la barre "Drawing"on tiens la peut être la réponse je vais essayer
si c'est bon c'est Gnain qui m'aura mis sur la voix

Pièce jointe 175146

**gnain** · 17/04/2015, 17h50

je les ai tous essayé comme ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
           For i = 1 To 23000
reco:
                Cells(1, 13) = i
                If i = 23000 Then Exit For
                On Error Resume Next
                Set palette2 = .Controls.Add(Type:=msoControlSplitButtonPopup, ID:=i) '1691
                If Err.Number Then
                    Err.Clear
                    i = i + 1
                    GoTo reco
                Else
                    MsgBox i
                    exit for
                End If
            Next

il en a sortie environ 25 dans le msgbox, et en les essayant tous, aucun fonctionne
il faut chercher ailleurs

j'ai remarqué quelque chose
en sélectionnant à la main il apparaît un petit losange jaune au coin gauche de la shape

en sélectionnant en vba il y en à pas ...

oublie ça, ce losange jaune apparaît juste en sélectionnant une shape

Bonjour,
essaie ça.
C'est un petit détour, mais c'est mieux que rien

**patricktoulon** · 17/04/2015, 21h17

on arrete pas de se croiser
je vais regarder ton dvp3
en attendant puré je galère grave je ne trouve toujours pas
par contre j'ai trouvé un autre palette couleur pour le font.color des cellules
a l'inverse de couleur des police celle la n'a pas de parent en effet elle est seule
pas besoins de la développer avec la fleche
expression représente le parent (command bars ou controlpopup parent

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set palette3 = expression.Controls.add(Type:=msoControlGrid, ID:=1927)

j'ai aussi modifié le fichier afin de pouvoir tester chaque ID dynamiquement au click droit sur le sheets 2
j'ai trouvé des choses intéressantes ca peut servir au autre
pour tester cliquez bouton souris droite et la command bars temporaire s'affiche avec le bouton que vous avez choisi en cliquant sur une cellule
fichier en piece jointe je pense qu'il a une utilité certaine
le popup affiche le bouton et ses caractéristiques
Pièce jointe 175182

**patricktoulon** · 17/04/2015, 21h42

re
alors je n'y comprend plus rien on a le même code et le mien ne fonctionne pas

il y a quelque chose que j'ai pas compris la

a quoi sert le cmdpolice dans l'évènement beforrightclick ??????? la difference viendrait elle de la ??????

le fait que la palette n'est pas réservé pour les shapes et comme elle ne sélectionne pas la couleur existante elle ne s'amorce pas c'est ca ????

ha !....

je pense avoir compris enfin
j'ai trouvé ton secret

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Shapes.Range(Array("toto", "titi")).Fill.ForeColor.RGB = ActiveSheet.Shapes.Range(Array("toto", "titi")).Line.ForeColor.RGB

cela voudrait dire que nous avons tout simplement a faire a un problème de rafraichissement d'écran

si c'est ca je suis écœuré ca fait 3 jours que je plombes dessus

la j'ai vraiment les boules

ca génère quand même un petit soucis
le petit losange jaune dont tu parlais est fait pour régler l'arrondi ou l'angle de coupe selon la shapes
ton system me le remet a l'initiale

**gnain** · 17/04/2015, 22h02

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Shapes.Range(Array("toto", "titi")).Fill.ForeColor.RGB = ActiveSheet.Shapes.Range(Array("toto", "titi")).Line.ForeColor.RGB

ceci prouve ce que je disait plutôt que le code envoie la couleur sur le contour (.Line) au lieu de la renvoyé dans la shape (.Fill)
donc en fessant un = l'autre on est ok

Pour le losange jaune, je l'ai réessayé ici, puis après le code, il y est toujours...

losange jaune pour arrondi
je vient de comprendre.
je ne sais pas pourquoi...

Pour l'arondi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Sh.Name = "page" Then
        Cancel = True
        If Target.Row = 1 Then barre2 Range("i2", "n2")
        If Target.Row = 5 Then barre2 Range("e6:q6")
        If Target.Row = 8 Then barre2 Range("e9:q24")
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Fill.ForeColor.RGB = ActiveSheet.Shapes.Range(Array("toto", "titi")).Line.ForeColor.RGB
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Select
        Selection.ShapeRange.Adjustments.Item(1) = 0.5
    End If

End Sub

**patricktoulon** · 17/04/2015, 23h04

oui c'est ce que j'ai fait

mais la on souleve un lievre avec cette methode
il m'est impossible comme tel de gérer les bordures

haha ...ha.....
je pense que je vais passer par une variable du genre oldbordercolor" que j'instruit avant et m'en sert après je vais voir

**gnain** · 17/04/2015, 23h29

comme ça on peut se passer de .OnAction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Sh.Name = "page" Then
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Select
        Cancel = True
        If Target.Row = 1 Then barre2 Range("i2", "n2")
        If Target.Row = 5 Then barre2 Range("e6:q6")
        If Target.Row = 8 Then barre2 Range("e9:q24")
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Fill.ForeColor.RGB = ActiveSheet.Shapes.Range(Array("toto", "titi")).Line.ForeColor.RGB
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Select
        Selection.ShapeRange.Adjustments.Item(1) = 0.5
    End If

End Sub

**patricktoulon** · 18/04/2015, 00h01

re

le .onaction du popup parent c'est ca

oui ca me permettrais ici aussi de mémoriser la couleur de la bordure avant que le popup s'affiche
ainsi après fill=fill line

je fait fill line =oldcouleur

ca me parait bon comme principe
j'essaierais demain la je n'ai plus de noeuil qui voit bien

merci je te dirais ca demain

**gnain** · 18/04/2015, 00h22

en plein ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Sh.Name = "page" Then
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Select
        Old_Color_Contour = ActiveSheet.Shapes.Range(Array("toto", "titi")).Line.ForeColor.RGB
        Cancel = True
        If Target.Row = 1 Then barre2 Range("i2", "n2")
        If Target.Row = 5 Then barre2 Range("e6:q6")
        If Target.Row = 8 Then barre2 Range("e9:q24")
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Fill.ForeColor.RGB = ActiveSheet.Shapes.Range(Array("toto", "titi")).Line.ForeColor.RGB
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Select
        Selection.ShapeRange.Adjustments.Item(1) = 0.5
        ActiveSheet.Shapes.Range(Array("toto", "titi")).Line.ForeColor.RGB = Old_Color_Contour
    End If

End Sub

**patricktoulon** · 18/04/2015, 00h29

re
tu es autant acharné que moi toi
tu lâche pas le morceau facilement

et il va falloir gérer aussi une variable de type boolean au ou je change la couleur de bordure cet variable sera forcement changée d'état par le popup
mais on verra demain la je suis plombé grave
mais on tiens le bon bout la on avance

**gnain** · 18/04/2015, 02h54

Envoyé par patricktoulon

re
tu es autant acharné que moi toi

!!!
essaie ça !!! bonne nuit!

**patricktoulon** · 18/04/2015, 09h00

Bonjour Gnain

que dire Mr
Respect

And the winner is!!.... GNAIN!!!!

en plus le code est d'une simplicité c'est propre ,nickel

vraiment bravo!!!
il me reste a intégrer le fontcolor maintenant hahahahaha
et a l'intégrer dans le reste de mon fichier
chez Microsoft il ont pas prévu de tomber sur toi

**patricktoulon** · 18/04/2015, 11h45

Bonjour Gnain
alors j'ai complètement changer de stratégie
en effet le dvp4 fonctionne a merveille mais beaucoup trop de variables a prendre en compte pour l'intégrer dans mon fichier
alors j'ai revu la stratégie
tout d'abors on change de control (palette de couleur) on prendra le controlgrid ID 1927
qui sert normalement pour le font des cellules bien que celui la l'application ne s'en sert pas dans les barres prévues a cet effet ( je sais pas pourquoi?)

ensuite
dans le Workbook_SheetBeforeRightClick
on intègre la possibilité du bandeau (1,2,3)
on intègre aussi dans chaque possibilité bandeau la possibilité "couleur fond , couleur texte ,couleur bordures )
on intègre aussi la possibilité que je ne fasse rien avec la variable oldcouleur

le menubar:
3 mode bandeau(1,2,3)
dans chaque bandeau 3 mode fond , texte , bordure )
dans le on action de chaque bandeau la variable "bande" change
dans chaque mode couleur la variable mode change
et dans chaque mode couleur la même palette couleur
au début de code pour la barre je select la cellule "T1 " qui me servira de mémoire tampon
on y écrit rien c'est seulement pour recevoir le font color de la palette ID 1927

ainsi après le before...... dans le module thisworkbook on gère selon ta méthode (avant/après) la bande et le mode couleur

et a chaque fois la couleur du fond ou du texte ou de la bordure devient la couleur du font .color de la cellule"T1"
et le tour est joué
on ne sélectionne même plus les shapes

j'ai préféré utiliser cette palette car elle n'a pas d'amplitude quand elle se développe juste une grille a l'inverse des autre palettes
ca fonctionne a merveille

je n'ai pas mis le bandeau 2 et 3
a la place tu a un msgbox qui te donne la bande et le mode couleur ce qui indique que la méthode est bonne

reste peut être a simplifier les 2 select case imbriqués (bande/mode) dans le before .....

mais c'est fonctionnel

**PMO2017** · 18/04/2015, 16h05

Bonjour,

Une autre approche en utilisant la méthode ExecuteMso (voir les ajouts de code cernés par des /// ).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Public modeshape As Boolean
 
Sub barre2(plage)
Dim MaBarre As CommandBar
Dim cpop(1 To 3)
Dim bandeau
Cancel = True
'---
deletebar
Set MaBarre = Application.CommandBars.add(Name:="Menu2", Position:=msoBarPopup)
Set cpop(1) = MaBarre.Controls.add(Type:=msoControlPopup)
With cpop(1)
  .BeginGroup = True
  .Caption = "bandeau 1"
  .OnAction = "'selectionrange  " & Chr(34) & 1 & Chr(34) & "'"
  Set ccomb = .Controls.add(Type:=msoControlComboBox, ID:=1728)    '<-- combofont
  Set ccomb2 = .Controls.add(Type:=msoControlComboBox, ID:=1731)
  Set P1 = .Controls.add(Type:=msoControlButton, ID:=113)
  P1.BeginGroup = True
  Set P2 = .Controls.add(Type:=msoControlButton, ID:=114)
  Set P3 = .Controls.add(Type:=msoControlButton, ID:=115)
  Set palette1 = .Controls.add(Type:=msoControlSplitButtonPopup, ID:=401)
  palette1.BeginGroup = True
 
 
'/// pmo
  Set palette2 = .Controls.add(Type:=msoControlButton)
  With palette2
    .Caption = "Format de la sélection"
    .FaceId = 1691
    .OnAction = "FormatDialog"
  End With
'////
 
 
End With
MaBarre.ShowPopup
Cancel = True
End Sub
 
'/// pmo
Sub FormatDialog(Optional dummy As Byte)
Application.CommandBars.ExecuteMso ("ObjectFormatDialog")
End Sub
'///
 
Sub deletebar()
On Error Resume Next
Application.CommandBars("Menu2").Delete
End Sub
 
Sub selectionrange(bande)
Select Case bande
  Case 1
    ActiveSheet.Shapes.Range(Array("toto", "titi")).Select
  'Case 2
 
  'Case 3
End Select
End Sub

**patricktoulon** · 18/04/2015, 16h20

Bonjour PMO

je vais voir ca mais j'ai pris une tout autre direction et ca semble fonctionner

cependant j'ai encore des résultantes de onaction de certains contrôles qui ne pourront pas êtres intégrés dans le before right click

alors peut être que la méthode executemso sera mon salut

j'avance doucement

**antonysansh** · 20/04/2015, 09h16

Bonjour à vous trois,

J'ai suivi le poste de loin car j'étais un peu dépassé par les évènements, mais j'ai pu en apprendre beaucoup en lisant vos différents post
Donc merci à vous

**patricktoulon** · 20/04/2015, 10h03

Bonjour gnain ; Antony ; PMO
voila ou j'en suis maintenant pour le moment

j'ai encore approfondi ma stratégie utilisant une celle comme mémoire tampon en utilisant toujours le controlgrid 1927(palette simple sans caption)

j'ai un soucis je crois de dépassement de capacité avec (union) dans l'évènement before

je ne comprend pas pourquoi ca bug de temps en temps
voila le fichier

**PMO2017** · 20/04/2015, 12h37

Bonjour,

Je te vois pédaler dans la choucroute.
Peut être serait-il plus simple d'utiliser la piste que j'ai indiquée dans le message #34. A toi de voir si cela peut simplifier.
J'ai construit un exemple que je mets en pièce jointe.

**gnain** · 20/04/2015, 12h39

Je l'ai essayé, je n'ai pas été capable de le faire buggé.
aurais-tu une démarche pour le faire buggé.

remarque: comme utilisateur j'aimerais bien choisir tout mes choix d'un seul coup
au lieu de faire bouton droit à chaque fois (ex: comme dans un userform).
mais il est vrai que je ne connais pas ton projet dans l'ensemble et il est peut-être préférable comme cela.

**gnain** · 20/04/2015, 12h44

Bonjour PMO2017
exactement la remarque que je viens de faire au message précédent, faire ses choix d'un seul coup.
mais ton idée est encore mieux que d'utilisé un userform. +1

ou combiné cette idée avec un userform pour tout les autre choix.

Selection qui ne se voit pas

Macros et VBA Excel

Discussions similaires

Partager

Partager