trouver le msocontroltype d'un control en ayant son ID

Version imprimable

14/04/2015, 21h57
patricktoulon

trouver le msocontroltype d'un control en ayant son ID
rebonjours a tous

dans la ligné de mon projet (utilisant des control existant d'une autre barre)
je cherche a connaitre le msocontroltype)d'un control dont j'ai le id

du genre
Code:

1 2 3 4 sub typeMSO() Set ctrl = Application.CommandBars.FindControl(ID:=1645) msgbox ctrl.MsoControlType end sub
typename donne commandbarcontrolbutton mais je ne sais pas comment récupérer le type du genre "msoControlPopup" ou "msoControlbutton" etc.....

une idée??? de comment récupérer ce type

Bonjour Patrick,

Une piste en énumérant les CommandBarControl

Code:

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
Sub TypeMSO()
Dim Ctrl As CommandBarControl
Dim cpt&
Dim h&
Dim i&
Dim T()
Dim S As Worksheet
Dim R As Range
Dim MsoTypes As Variant
Dim MsoNames As Variant
Dim Titres As Variant
'---
MsoTypes = Array(22, 26, 1, 5, 12, 4, 0, 3, 2, 16, 19, 8, 20, _
      9, 11, 18, 15, 24, 7, 21, 10, 23, 14, 13, 6, 17, 25)
MsoNames = Array("msoControlActiveX", "msoControlAutoCompleteCombo", "msoControlButton", "msoControlButtonDropdown", _
      "msoControlButtonPopup", "msoControlComboBox", "msoControlCustom", "msoControlDropdown", "msoControlEdit", _
      "msoControlExpandingGrid", "msoControlGauge", "msoControlGenericDropdown", "msoControlGraphicCombo", _
      "msoControlGraphicDropdown", "msoControlGraphicPopup", "msoControlGrid", "msoControlLabel", "msoControlLabelEx", _
      "msoControlOCXDropdown", "msoControlPane", "msoControlPopup", "msoControlSpinner", "msoControlSplitButtonMRUPopup", _
      "msoControlSplitButtonPopup", "msoControlSplitDropdown", "msoControlSplitExpandingGrid", "msoControlWorkPane")
Titres = Array("ID", "Name", "Description", "Type", "MsoControlType")
'--- Des propriétés CommandBarControl ---
For i& = 1 To 3000
  Set Ctrl = Application.CommandBars.FindControl(ID:=i&)
  If Not Ctrl Is Nothing Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To 5, 1 To cpt&)
    T(1, cpt&) = Ctrl.ID
    T(2, cpt&) = Ctrl.accName
    T(3, cpt&) = Ctrl.accDescription
    T(4, cpt&) = Ctrl.Type
    For h& = LBound(MsoTypes) To UBound(MsoTypes)
      If Ctrl.Type = MsoTypes(h&) Then
         T(5, cpt&) = MsoNames(h&)
        Exit For
      End If
    Next h&
  End If
Next i&
'--- Inscription des résultats dans une nouvelle feuille ---
Sheets.Add after:=Sheets(Sheets.Count)
Set S = ActiveSheet
Set R = S.Range(S.Cells(2, 1), S.Cells(UBound(T, 2) + 1, UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
'--- Titres des colonnes ---
Set R = S.Range("a1:e1")
R = Titres
R.Font.Bold = True
End Sub

PS
Chez moi et sous Excel 2007 le CommandBarControl ayant l'ID 1645 est introuvable.

15/04/2015, 10h58
joe.levrai

Je crois qu'il va pas l'aimer ta solution :ptdr:

Elle demeure cependant la "moins pire" au vu de la quantité astronomique de propositions

Patrick veut pouvoir récupérer le msocontroltype sans passer par des transco, j'ai essayé pendant 1h mais sans succès (ça m'étonne pas :aie:)

Bonjour à tous,

ou bien (j'ai copié la liste de PMO) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Dim dictMsoTypes
Sub init()
    Dim MsoTypes, MsoNames, i As Long
    MsoTypes = Array(22, 26, 1, 5, 12, 4, 0, 3, 2, 16, 19, 8, 20, _
                     9, 11, 18, 15, 24, 7, 21, 10, 23, 14, 13, 6, 17, 25)
    MsoNames = Array("msoControlActiveX", "msoControlAutoCompleteCombo", "msoControlButton", "msoControlButtonDropdown", _
                     "msoControlButtonPopup", "msoControlComboBox", "msoControlCustom", "msoControlDropdown", "msoControlEdit", _
                     "msoControlExpandingGrid", "msoControlGauge", "msoControlGenericDropdown", "msoControlGraphicCombo", _
                     "msoControlGraphicDropdown", "msoControlGraphicPopup", "msoControlGrid", "msoControlLabel", "msoControlLabelEx", _
                     "msoControlOCXDropdown", "msoControlPane", "msoControlPopup", "msoControlSpinner", "msoControlSplitButtonMRUPopup", _
                     "msoControlSplitButtonPopup", "msoControlSplitDropdown", "msoControlSplitExpandingGrid", "msoControlWorkPane")
    Set dictMsoTypes = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(MsoTypes)
        dictMsoTypes(MsoTypes(i)) = MsoNames(i)
    Next i
End Sub
 
Sub test()
    Dim Ctrl
    init
    Set Ctrl = Application.CommandBars.FindControl(ID:=1)
    MsgBox dictMsoTypes(Ctrl.Type)
End Sub

eric

15/04/2015, 13h25
patricktoulon

re

Bonjour a tous les 3
Pmo,eriic,joe

ok encore une fois on passe par des moulinette

mais ca fait rien je garde

je suis en train de me faire un outils pour justement récupérer les caracteristuque des controls

afin de pouvoir m'en servir quand je me sert d'un control existant dans une de mes commandbars

mais depuis hiers j'avais reussi a trouver les controls que je cherchais

votre solution va s'introduire dans mon outils de liste de controls dispo

merci a tous les 3

et si ca me plait quand meme car la ca n'est pas pour une application c'est juste un outils qui me servira quand je chercherais un control en particulier
15/04/2015, 13h43
eriiic

Re,

Une piste qui pourrait t'intéresser :
http://access.developpez.com/faq/?pa...s#ConstantName
Reste plus qu'à trouver dans quel fichier se trouve cette énumération maintenant.

eric

re
salut eriic je suis allez voir ca me parait interessant surtout que la on parle de constantes vba en general pas que les commandbars

ensuite pour parfaire la routine de PMO
j'ajoute ceci:
histoire d'avoir les icons correspondants

a la fin de la routine de PMO lancer celle ci

Code:

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
Function eface_toute_image()
'Supprime le contenu de la feuille
    Worksheets("Feuil1").Pictures.Delete
End Function
Sub Liste_FaceIDs()
    eface_toute_image
    Application.ScreenUpdating = False
    Dim tBar As CommandBar
    Dim i As Long
        'Supprime la barre d'outils temporaire si elle existe.
    On Error Resume Next
    Application.CommandBars("BarreTemp").Delete
    On Error GoTo 0
 'Création barre d'outils
    Set tBar = Application.CommandBars.Add(Name:="BarreTemp")
    With Sheets(1)
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
 
             'Crée un nouveau bouton dans la barre d'outils
            With tBar.Controls.Add(Type:=msoControlButton)
                .FaceId = Sheets(1).Cells(i, 1).Value 'Ajoute un FaceID
                  .CopyFace 'Copie le FaceID
                                Sheets(1).Paste 'Effectue le collage dans la feuille
                'Repositionne et nomme la nouvelle forme collée
                Sheets(1).Shapes(Sheets(1).Shapes.Count).Top = Sheets(1).Cells(i, 1).Top
                Sheets(1).Shapes(Sheets(1).Shapes.Count).Left = 10
          'On Error GoTo 0
          End With
           Next i
    End With
    'Supprime la barre d'outils temporaire
    Application.CommandBars("BarreTemp").Delete
    Application.ScreenUpdating = True
    DoEvents
    MsgBox "Terminé."
End Sub

Apercu
Pièce jointe 174922