lister les faces d'icones excel 2010

[Blafi]

Bonjour à tous,

J'avais trouvé voici quelques années sur cet excellent forum, une procédure VBA qui me permettait de lister dans une feuille toutes les faces d'icones d'excel (FaceIds) et d'en copier une pour éventuellement s'en servir. Je vous joins cette procédure ci-dessous...

Malheureusement cette procédure ne marche pas avec excel 2010 et, pour établir un mode d'emploi sur un programme que j'ai créé, j'aurais besoin de récupérer l'icone que j'ai mise dans la barre d'accès rapide (correspondant au fichier à ouvrir par l'utilisateur et affecté à partir de la "personnalisation" de la barre d'accès rapide) pour pouvoir l'insérer dans mon mode d'emploi....

L'auteur (malheureusement je ne sais pas qui) ou quelqu'un d'autre pourraient-ils adapter cette procédure pour que ça marche avec excel 2010...

Merci d'avance et à bientôt...

Les proc d'origine :

Sub ShowFaceIDs()
Dim NewToolbar As CommandBar
Dim NewButton As CommandBarButton
Dim I As Integer, IDStart As Integer, IDStop As Integer

' Delete existing FaceIds toolbar if it exists
On Error Resume Next
Application.CommandBars("FaceIds").Delete
On Error GoTo 0

' Add an empty toolbar
Set NewToolbar = Application.CommandBars.Add _
(Name:="FaceIds", temporary:=True)
NewToolbar.Visible = True

' Change the following values to see different FaceIDs
IDStart = 1
IDStop = 250

For I = IDStart To IDStop
Set NewButton = NewToolbar.Controls.Add _
(Type:=msoControlButton, ID:=2950)
NewButton.FaceId = I
NewButton.Caption = "FaceID = " & I
'NewButton.CopyFace 'pour copier les icones dans la feuille
'ActiveSheet.Paste Destination:=Cells(i, 1)
Next I
NewToolbar.Width = 600
End Sub

Sub CopierIcones()
'Obtenir en A1 l'image du bouton "Copier"
CommandBars.FindControl(ID:=CommandBars("Standard").Controls("Copier").ID).CopyFace
ActiveSheet.Paste Destination:=Range("A1")
End Sub

 

[fanfan38]

Re : lister les faces d'icones excel 2010

Bonjour

En dernier, sur la barre d'outils (accueil, insertion, mise en page,..) tu as un onglet "compléments" qui s'ajoute quand tu fais fonctionner ta macro... Ta barre d'outils est là...

A+ François

 

[Blafi]

Re : lister les faces d'icones excel 2010

Merci fanfan38, mais ça ne répond pas à ma question...

Je ne cherche pas une barre d'outils mais le myen d'afficher toutes les icones de raccourcis dans excel... et le simple fait d'essayer de lancer cette macro ne donne aucun résultat..

Quelqu'un a une solution ?

 

[Blafi]

Re : lister les faces d'icones excel 2010

Re,
Pour fanfan38 : rectification : j'ai bien une barre qui s'affiche avec toutes les icones et en lançant ma macro après avoir enlevé l'apostrophe du commentaire à la ligne "copier les FaceID) j'ai réussi a en copier toutes les icones dans une feuille...

Ca marche donc.. merci.

Par contre je cherche le nom et l'emplacement du fichier (dll?) qui contient toutes ces icones.. peux -tu me le dire ??

A bientôt..

 

[fanfan38]

Re : lister les faces d'icones excel 2010

Le résultat est dans une barre d'outils... (c'est pas moi qui ai fait la macro)...

Cette macro là te le donnera sur la page active...
Sub ShowFaceIDs()
Dim NewToolbar As CommandBar
Dim NewButton As CommandBarButton
Dim I As Integer, IDStart As Integer, IDStop As Integer

' Delete existing FaceIds toolbar if it exists
On Error Resume Next
Application.CommandBars("FaceIds").Delete
On Error GoTo 0

' Add an empty toolbar
Set NewToolbar = Application.CommandBars.Add _
(Name:="FaceIds", temporary:=True)
NewToolbar.Visible = True

' Change the following values to see different FaceIDs

IDStop = 250

For I = 1 To IDStop
Set NewButton = NewToolbar.Controls.Add _
(Type:=msoControlButton, ID:=2950)
NewButton.FaceId = I
NewButton.Caption = "FaceID = " & I
NewButton.CopyFace 'pour copier les icones dans la feuille
ActiveSheet.Paste Destination:=Cells(I, 1)
ActiveSheet.Cells(I, 2).Value = "FaceID = " & I
Next I
Application.CommandBars("FaceIds").Delete
End Sub

Là tu peux faire un copier/coller...
A+ François

 

[Blafi]

Re : lister les faces d'icones excel 2010

RE bonsoir fanfan38,

Je tapais ma dernière réponse quand tu as posté la tienne ...
J'ai essayé ta macro et en effet ç amarche très bien..

Encore merci et à ++

 

[13GIBE59]

Re : lister les faces d'icones excel 2010

Bonjour le forum, bonjour blafi et fanfan.

Sinon, à voir le fichier joint, qui en contient beaucoup plus que 250, je crois.

 

[JCGL]

Re : lister les faces d'icones excel 2010

Bonjour à tous,

J'avais cru comprendre que notre ami souhaitait récupérer les "icônes" d'XL 2007 et supérieur, en cliquant sur une des images présentes dans l'USF.

A + à tous

 

[Blafi]

Re : lister les faces d'icones excel 2010

Bonsoir,

Pour faire suite à ma demande d'hier et aux réponses reçues, je précise:

- Pour JCGL : C'est bien les icones de excel 2007 et supérieur (donc 2010) que je désire récupérer en image soit ico, soit autre..

- Pour 13GIBE59 : oui j'avais, entre temps, résupéré le fichier que tu cites mais le pb est qu'on obtient bien une boite de dialogue qui affiche l'icone sélectionnée dans la boite d'outils mais je n'ai pas bien compris comment on peut en "récupérer" l'image pour pouvoir la coller ensuite, par exemple dans une cellule... et le mieux du mieux, coller toutes les icones dans les cellules d'une feuille...

Merci d'avance si vous avez une solution...

A ++

 

[JCGL]

Re : lister les faces d'icones excel 2010

Bonjour à tous,

Ce code, de Charles RACAUD sur VBFrance, extrait les icônes d'XL 2007.
Plus de la moitié des 22 000 images BMP sont vides... Ce sont des BMP en 16 x 16

Option Explicit


Public Sub GetOfficeButton()


  ' Affiche une boîte de dialogue pour choisir le dossier d'extraction
  Dim Dlg As Office.FileDialog
  Set Dlg = Application.FileDialog(msoFileDialogFolderPicker)
  Dlg.AllowMultiSelect = False
  Dlg.Show
  Dlg.InitialFileName = Application.ThisWorkbook.Path & "\"
  If Dlg.SelectedItems.Count > 0 Then
  
    Const FileExt As String = ".bmp"
    Const nbFileDigit As Integer = 5
  
    Dim ExtractDirectory As String: ExtractDirectory = Dlg.SelectedItems(1)
    If Right$(ExtractDirectory, 1) <> "\" Then ExtractDirectory = ExtractDirectory & "\"


    ' Bouton temporaire
    Dim TblBtn As Office.CommandBarButton
    Set TblBtn = Application.CommandBars(1).Controls.Add(Office.msoControlButton)


    ' Extraction
    On Error Resume Next
    Dim nBtn As Integer
    Do ' Comme on ne connait pas le nombre de boutons
      nBtn = nBtn + 1 ' Incrémente le nombre de boutons trouvés
      TblBtn.FaceId = nBtn ' Attribut l'image du bouton
      If Err.Number = -2147467259 Then Exit Do ' Si le bouton n'a pas été trouvé (on est arrivé à la fin), on quitte la boucle
      Dim BtnId As String: BtnId = FormatInt(nBtn, nbFileDigit) ' Formatage du nom de l'image
      SavePicture TblBtn.Picture, ExtractDirectory & BtnId & FileExt ' Enregistre l'image
    Loop
    Err.Clear
    On Error GoTo 0
      
    MsgBox "Terminer" & vbNewLine & nBtn & " images extraites.", vbInformation, "GetOfficeButton"
    
    TblBtn.Delete ' Supprime le bouton temporaire
  End If
End Sub


Private Function FormatInt(ByVal n As Integer, ByVal Lenght As String) As String
  Dim sn As String: sn = CStr(n)
  If Len(sn) < Lenght Then
    FormatInt = String(Lenght - Len(sn), "0") & sn
    Exit Function
  End If
  FormatInt = n
End Function

A + à tous

 

[Blafi]

Re : lister les faces d'icones excel 2010

Bonsoir,
Merci JCGL, je vais essayer ce code mais c'est vrai qu'avec 22000 imgaes ça va faire beaucoup.
A ++