Extraction des icônes des menu d'office

Soyez le premier à donner votre avis sur cette source.

Vue 21 538 fois - Téléchargée 1 402 fois

Description

Chose demander plusieurs fois sur le forum.
J'ai donc décider de faire un petit code simple qui permet cela.
Mais, ce code ne marche que pour office Xp, 2002, 2003, 2007.

Pour office 2000, j'ai fait le code en vb6 car c'était plus simple à faire et plus rapide.
Donc, le projet est dans le zip (il faudra ajouter les références "Microsoft Excel Object Library" et "Microsoft Office Object Library" pour que ca marche.

Source / Exemple :


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

Conclusion :


Avec ca on à 15934 icônes pour office 2007.
Pour l'amélioration, faudra filtrer les images ; la moitié des images extraites sont vides !!! (les menus sans icônes)
Pour le projet vb6, il détecte les images vides et les sauvegarde pas. Reste a le faire pour le projet vba.
Testé sous office 2000, 2003 et 2007.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
3172
Date d'inscription
dimanche 15 février 2004
Statut
Membre
Dernière intervention
9 avril 2017
35
Oui, je verrai ca. C'est vrai qu'on pourrait faire un meilleur traitement. Par contre, ca jouera sur la rapidité de l'extraction.
__
Kenji
Messages postés
167
Date d'inscription
jeudi 9 décembre 2004
Statut
Membre
Dernière intervention
18 novembre 2007
1
Tu pourrais faire une version .NET qui conserve les canaux alpha ?
Les images ressortent sur fond noir :(
Une sortie en .png ou .ico serait cool :)
Messages postés
3172
Date d'inscription
dimanche 15 février 2004
Statut
Membre
Dernière intervention
9 avril 2017
35
Ok, merci pour tes commentaires.
Je vais reprendre un peu tout ca.
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
14
Serait cool que tu mettes une progress abr pour avoir l'avancement de l'extration des icones...j'ai eu + de 10000 fichiers et je me demandais si le prog avait planter !Lol.
Serait bien aussi de pouvoir enregistrer les extractions dans un répertoire choisi par l'utilisateur au lieu de la faire dans le répertoire choisi pour faire commencer l'extraction.
A+
Exploreur
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
14
salut,

c'est exactement ce que je chercher.
9/10
A+
Exploreur
Afficher les 12 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.