none
Is It Possible To Extract An Icon From The File System And Then Apply It As A Face On A Custom Toolbar? RRS feed

  • Question

  • I am creating an Excel application, based on VBS code I found on the Hey Scripting Guy site, to read and modify an Excel spreadsheet.  This Excel application creates a custom toolbar via VBA code so the user is able to select either the "Download" or "Upload" toolbar popup menus to then display a menu list with "All", "User", "Group", or "Computer".  After looking through the collection of thousands of available Microsoft Office Face ID's, I found acceptable Face ID's for most of the menu items with "All" as 9927, "User" as 607, "Group" as 3198, but I could not find is a Microsoft Office Face ID showing a computer within the collection.  What I would like to do now, if it is possible, is somehow get the Icon for "My Computer" from Explorer.exe and use this as the Face for the “Computer” menu option within my custom toolbar.  Is there a way to extract an icon from a resource file (*.exe, *.dll, *.ico) and apply it as a face on a custom toolbar menu item?

    Thursday, October 20, 2011 9:02 AM

Answers

  • You can insert the ico file as a picture on a worksheet in your app, then use code like

         Set cbcMenuItem = cbBarObj.Controls.Add _
                          (Type:=msoControlButton)
        With cbcMenuItem
            .Style = msoButtonIconAndCaption

            .Caption = "&Computer"
            .OnAction = ThisWorkbook.Name & "!SelectComputer"
            .Tag = "This is a tag"

            .BeginGroup = True
            ThisWorkbook.Worksheets("Sheet1").Shapes("picComputer").Copy
            .PasteFace
        End With


    HTH, Bernie
    Thursday, October 20, 2011 2:05 PM
  • Michael,

    For future reference, to rename a picture you can simply select it, then type your desired name in the name box (located to the left of the formula entry). As long as the name is not a valid cell address and doesn't have invalid characters....

    Bernie


    HTH, Bernie
    Friday, October 21, 2011 4:41 PM

All replies

  • You can insert the ico file as a picture on a worksheet in your app, then use code like

         Set cbcMenuItem = cbBarObj.Controls.Add _
                          (Type:=msoControlButton)
        With cbcMenuItem
            .Style = msoButtonIconAndCaption

            .Caption = "&Computer"
            .OnAction = ThisWorkbook.Name & "!SelectComputer"
            .Tag = "This is a tag"

            .BeginGroup = True
            ThisWorkbook.Worksheets("Sheet1").Shapes("picComputer").Copy
            .PasteFace
        End With


    HTH, Bernie
    Thursday, October 20, 2011 2:05 PM
  • Bernie, thanks for your reply.  As I started to implement your proposed solution, as this woulld be the first time that I would attempt to extract an icon from a resource file (*.exe, *.dll, *.ico), I ran into a problem.  I realize I could just snap a screen shot of what I want but this would not capture the transparent part of the icon designed to let the background to show through.  When I see the Explorer's "My Computer" icon on the Windows XP desktop and the properties of Explorer.exe, they look like this:

    In the Explorer.exe properties window, the background surrounding the icon for the computer shows through as grey and for the My Computer icon on the desktop the background for this icon shows through as blue.  What would the recommend way be to extract the My Computer icon from Explorer.exe for placement within an Excel worksheet where the transparency around the picture of the computer is not lost in the process?  The only way I know how to get this graphic is to do a screen capture which won't preserve the transparency.  Does anybody know of a way to copy the icon graphic from the executable while preserving the transparancy or to answer my more difficult original question which is to programmatically copy the icon graphic directly from the executable, as both solutions would likely work for solving this problem for me?




    Friday, October 21, 2011 5:45 AM
  • I finally discovered how to solve my problem, how to properly extract the "My Computer" icon from either Explorer.exe or Shell32.dll and have it be transparent as a Face on my custom command toolbar.  Here is what I had to do:

    -  Download a program to extract the icon from the resource file, I used the NirSoft IconsExtract Utility and extracted the "My Computer" icon from Shell32.dll offset 16 and copied it to the clipboard.

    -  In Excel I created a new worksheet, that I later intend to hide before distribution to the users, and renamed it to "IconFace", and then selected the entire workbook by clicking on the left of Column "A" and just above Row "1" and clicked the Paint Bucket toolbar button to set the color of the spreadsheet to Orange, as it will provide high contrast against black and white when setting the transparancy.

    -  I selected cell "A1" then pasted the contents of the clipboard with the icon which shows a black background surrounding the icon that should be transparent, but isn't.  From what I was trying to do and it not working, it would appear that when a transparent graphic is pasted into Excel it looses its transparancy.

    -  A search of Excel help online lead me to the article, "Change the brightness, contrast, or transparency of a picture" at http://office.microsoft.com/client/helpcategory.aspx?CategoryID=CH101020799990&lcid=1033&NS=EXCEL&Version=12, so I was able to update the pasted graphic to make the surrounding background to the icon transparent, by selecting the lower right hand corner which is black using the transparancy selection tool.

    -  The resulting transparent icon needed a bit of touchup, so I copied and pasted it into Paint which rendered the transparent background as white, I selected white as my pencil color and removed some of the extra nearly black pixels that remained on the bottom (if they were totally black they would have become transparent), then copied the result back into Excel and reset the transpanancy color as white.

    -  For my toolbar VBA code to work with the icon, I needed to know its name and change it to something more meaningful, so in the Visual Basic editor window I created a temporary module and inserted the following code:

    Sub DisplayIconName()
       For Each objShape In ActiveSheet.Shapes
          Debug.Print objShape.Name
       Next
    End Sub

    In the Immediate pane I typed the following code indicated in bold type and the reply by Debug.Print is indicated in regular unbolded type:

    DisplayIconName
    Picture 43
    ActiveSheet.Shapes("Picture 43").Name = "My Computer"
    DisplayIconName
    My Computer

    -  I was then able to update my toolbar code to include Bernie's code to get the result I was looking for as:

            ThisWorkbook.Worksheets("IconFace").Shapes("My Computer").Copy
            objCmdButton.PasteFace

         Thank you Bernie, I could not have gotten this far to find my solution without your suggestion.

              Mike

     

    Friday, October 21, 2011 2:45 PM
  • Michael,

    For future reference, to rename a picture you can simply select it, then type your desired name in the name box (located to the left of the formula entry). As long as the name is not a valid cell address and doesn't have invalid characters....

    Bernie


    HTH, Bernie
    Friday, October 21, 2011 4:41 PM
  • I previously thought that Bernie and I had come up with the definitive answer, but I ran into trouble with this solution when I started distributing my Excel application.  Users that were launching my application started reporting the following run time error, “Run-time error ‘-2147467259 (80004005)’: Method ‘PasteFace’ of object ‘_CommandBarButton’ failed”, and clicking on the Debug shows that the error is with my “.PasteFace”, as shown below.

     

    Further complicating and frustrating the matter, is that I cannot recreate the problem to trouble shoot it, the Shapes .Copy and Command Button .PasteFace methods have always been working for me, but I have distributed it to four others via Email and three out of four experienced this problem when running this application for the first time, running it as an email attachment or saving the file first, does not seem to make a difference.  Unfortunately the fix for the application user is not just to quit and launch the Excel workbook again, but havign the user log out and log in again seems to clear the problem for them; not sure why this would fix this problem or what its root cause is, but I would like to fix it before widening the distribution.  From what I can ascertain about the problem, it would appear to be caused by something possibly getting stuck on the clipboard that cannot be deleted.  After searching the internet I ran across the following related posts:

    https://www-304.ibm.com/support/docview.wss?uid=swg21362037
    http://www.vbaexpress.com/forum/archive/index.php/t-8866.html
    http://www.wilmott.com/messageview.cfm?catid=10&threadid=61370&forumid=1
    http://www.dailydoseofexcel.com/archives/2005/02/10/custom-commandbarbutton-faces-in-vba/
    http://support.microsoft.com/kb/288771
    http://support.microsoft.com/kb/286460
    http://vb.mvps.org/hardcore/html/pictureobjects.htm

     

    The most promising solution to the problem is within Microsoft KB 286460, which avoids the use of the clipboard altogether, which would be a better solution, because I would rather not change the user’s computer environment by altering their clipboard contents.  But as I attempted to implement the method described within this KB article, it shows how to take a face from an external file, and although that is similar to what I originally wanted at the start of this thread, I realize now that using icons distributed within the Excel application on a hidden worksheet is the better method.  The problem I have now is that I cannot get the StdPicture object handle needed to point to the Shapes object for the button face assignment of the Picture property to work.  I am attempting to replace something like:

    ThisWorkbook.Worksheets("FaceIcon").Shapes("My Computer").Copy
    objCmdButton.PastFace
     

    With:

    objCmdButton.Picture = ThisWorkbook.Worksheets("FaceIcon").Shapes("My Computer")

    which would avoid the clipboard problem altogether, but this code produces a type mismatch error.  There seems to be a problem with using the Shapes object reference to set the StdPicture object .Picture property.  According to the “Hardcore Visual Basic” book hosted on the internet link given above in Chapter 7, using the .Picture property is equivalent to .Picture.Handle, as Handle is the Picture’s default property.  That is to say that the following lines of code taken from the Hardcore reference, produce the same result.

    imgCur.Picture = LoadPicture("Thing.Ico")

     

    actually means:

    imgCur.Picture.Handle = LoadPicture("Thing.Ico")

     

    I used object explorer and the locals window in the VBE debugger, to see what properties and methods for the Shape object are available, but none seemed to be appropriate to get the needed StdPicture handle to assign it to the .Picture.Handle property.  Anybody have any ideas for solving this problem?

     


    Thursday, October 27, 2011 1:54 PM
  • I have been distributing workbooks with commandbar creation code for years and years and have never seen that error on any machine.

    Can you post your code somewhere? It seems like your arrToolBarButtonDef(1) needs to be a valid style (which is a defined numeric constant), but it is being used as a caption elsewhere - meaning it is defined as a string?

    It needs to be a constant defined like

    Dim ToolBarButtonDefStyle As MsoButtonStyle

        ToolBarButtonDefStyle = msoButtonIconAndCaption
       

          With cbcMenuItem
            .Style = msoButtonIconAndCaption  'using the defined constant
            .Style = ToolBarButtonDefStyle  'using the variable set as the constant

     


    HTH, Bernie
    Thursday, October 27, 2011 4:06 PM
  • I am very interested in understanding and correcting the problem with the Copy and PasteFace method, suggested by Bernie, which transfers the button face image through the use of the clipboard, so users that receive my application do not encounter a PasteFace error when launching my application for the first time.  I am also still interested in implementing the method described within Microsoft KB article 286460, as this method if I can get it to work, would not overwrite what the user may have placed upon the clipboard.

    I figure a few general comments about my programming style are in order so you will better understand what you are looking at when you review my code below, as I have not edited the code to make it look pretty for this posting.  As a network administrator, I did a lot of programming in Command Shell (previously DOS) to push software onto workstations starting with a Windows NT 3.1 / Windows For Workgroup v3.11 network, nearly two decades ago, and about 7 years ago, I discovered how useful Visual Basic Script was to automate adjustments for network administration, and decided to start a serious study of the language by reading the Windows 2000 Scripting Guide and several articles on the Hey Scripting Guy's website.  I have recently, within the last 3 years or so, started taking an interest in gathering data about my workstations from my servers that manage these networked workstations and analyzing and presenting this data within Microsoft Office applications such as Excel and Access.  With this course of study and application, my Visual Basic for Applications (VBA) code in many ways may read more like VB Script than VBA, as I am using implicit variable declaration rather than explicit type specified declarations, and variant variable types to hold more than one type of data in lieu of proper type casting; for these sloppy VBA programming practices, I apologize for those that may wish to use the code I have posted below as they may need to adjust my code with appropriate explicit variable declarations to make it work within their code modules...  As I develop code, I usually test it as I write it, and when I come up with a better idea, I usually just remark out the line of code that I was using, and replace it with a better version of the line of code below it; you will definitely see evidence of this in the spot in code, indicated in bold type, where I am having this problem.  This practice helps me as I have often put a programming project aside for a while and then come back to it when I have the time to work on it some more, and find that I don't always remember what I have tried before and leaving this old retired code in the module, keeps me from repeating my experimental work again.

    More specifically to comment on this particular VBA project running in Excel, which has undergone some occasional revision over the last three years of its development, the user launches an Excel workbook clicks on the Security warning dialog and enables the macros, at which time the custom toolbar is dynamically created by VBA code.  This workbook is designed to query Active Directory and display and update object properties for Users, Groups, and Computers.  One of the revisions programmed last year was to add a custom toolbar support, so the users did not have to navigate through four layers of the Excel built in menus (Excel 2003's Tools: Macros...: Macro: Macro List) to find and execute macros from the list of macros.  As I was maintaining two different versions of this Application, a full version and a simplified light version, I needed to support two different sets of toolbar menus, then I got the idea of not programming each toolbar separately with highly customized and very specific code, but rather create a generalized function that takes parameters instead to define the toolbar to be created, making my code portable to any VBA project that needs a custom toolbar, without having to write the actual toolbar code.  Now, as an enhancement, I am trying to add pretty and meaningful pictures to those custom toolbar menus and am running into trouble...  Below is a screen capture showing what the toolbar looks like when everything works as it should.  The All menu option face is actually FaceID 9927, and the User, Group, and Computer faces were collected by screen capture from Active Directory Users and Computers applet and saved as 16 x 16 bit images that were then pasted to the FaceIcon worksheet with the shapes renamed to "User", "Group", and "Computer".  I gave up on using the "My Computer" 32 x 32 bit image that I captured, after some testing, as there was some ugly distortion when it rendered the 32 x 32 bit image as a 16 x 16 bit image.  Bernie, if you would like me to send you the entire Excel workbook project, so that you may conduct some testing or to see what my project does, please send an email to me at Michael.Weigert@pac.dodea.edu, and I will send it to you as an email attachment.  Anybody that wishes to use the functions posted here within their code is welcome to do so, if major improvements in functionality are created, I ask that you post your updated code to this thread so others may benefit.

    Within the VBA Project window, Microsoft Excel Objects, ThisWorkbook module the following code handles the workbook events related to maintaining the custom toolbar:

    Private Sub Workbook_Open()
       Const ARROW_DOWN = 135
       Const ARROW_UP = 134
       'Const SORT_AZ = 2916
       Const SORT_AZ = 3157
       Const SORT_ZA = 3158
       Const USERS_AT_SERVER = 9927
       subRemoveToolBar "AD Data Exchange"
       'subCreateToolBar "AD Data Exchange", Array( _
       '   Array(msoControlPopup, "Download", Array( _
       '      Array(msoControlButton, msoButtonCaption, "All", 0, "Download All", "Download_All"), _
       '      Array(msoControlButton, msoButtonCaption, "User", 0, "Download User", "Download_User"), _
       '      Array(msoControlButton, msoButtonCaption, "Group", 0, "Download Group", "Download_Group"), _
       '      Array(msoControlButton, msoButtonCaption, "Computer", 0, "Download Computer", "Download_Computer"))), _
       '   Array(msoControlPopup, "Upload", Array( _
       '      Array(msoControlButton, msoButtonCaption, "All", 0, "Upload All", "Upload_All"), _
       '      Array(msoControlButton, msoButtonCaption, "User", 0, "Upload User", "Upload_User"), _
       '      Array(msoControlButton, msoButtonCaption, "Group", 0, "Upload Group", "Upload_Group"), _
       '      Array(msoControlButton, msoButtonCaption, "Computer", 0, "Upload Computer", "Upload_Computer"))))
       'Face ID's of interest for Upload and Download, unfortunately there is not a picture of a computer within
       'the Microsoft Office collection of Face ID's.
       '   Download                    40, 135
       '   Upload                      38, 134
       '      All
       '         Happy Face            59
       '         Table Bolt            107
       '         Folder Arrow          106
       '         Bright Light Bulb     1000
       '         Two Users at Server   9927, 9939
       '      User
       '         User over book        362
       '         User                  607
       '         User                  2103
       '      Group
       '         Two user with Arrow   327
       '         Geometric Shapes      1029
       '         Users + -             1086
       '         Two user with Globe   2126
       '         Two users             2131
       '         Two users             5434~6, 5452~3
       '         Two users in Hand     3198
       '         User over directory   3709
       '         Three users           9175
       '         Two users with cog    9648
       '      Computer
       '         Printer               2521
       'subCreateToolBar "AD Data Exchange", Array( _
       '   Array(msoControlPopup, "Download", Array( _
       '      Array(msoControlButton, msoButtonIconAndCaption, "All", 9927, "Download All", "Download_All"), _
       '      Array(msoControlButton, msoButtonIconAndCaption, "User", 607, "Download User", "Download_User"), _
       '      Array(msoControlButton, msoButtonIconAndCaption, "Group", 3198, "Download Group", "Download_Group"), _
       '      Array(msoControlButton, msoButtonIconAndCaption, "Computer", "My Computer", "Download Computer", "Download_Computer"))), _
       '   Array(msoControlPopup, "Upload", Array( _
       '      Array(msoControlButton, msoButtonIconAndCaption, "All", 9927, "Upload All", "Upload_All"), _
       '      Array(msoControlButton, msoButtonIconAndCaption, "User", 607, "Upload User", "Upload_User"), _
       '      Array(msoControlButton, msoButtonIconAndCaption, "Group", 3198, "Upload Group", "Upload_Group"), _
       '      Array(msoControlButton, msoButtonIconAndCaption, "Computer", "My Computer", "Upload Computer", "Upload_Computer"))))
       subCreateToolBar "AD Data Exchange", Array( _
          Array(msoControlPopup, "Download", Array( _
             Array(msoControlButton, msoButtonIconAndCaption, "All", USERS_AT_SERVER, "Download All", "Download_All"), _
             Array(msoControlButton, msoButtonIconAndCaption, "User", "User", "Download User", "Download_User"), _
             Array(msoControlButton, msoButtonIconAndCaption, "Group", "Group", "Download Group", "Download_Group"), _
             Array(msoControlButton, msoButtonIconAndCaption, "Computer", "Computer", "Download Computer", "Download_Computer"))), _
          Array(msoControlPopup, "Upload", Array( _
             Array(msoControlButton, msoButtonIconAndCaption, "All", USERS_AT_SERVER, "Upload All", "Upload_All"), _
             Array(msoControlButton, msoButtonIconAndCaption, "User", "User", "Upload User", "Upload_User"), _
             Array(msoControlButton, msoButtonIconAndCaption, "Group", "Group", "Upload Group", "Upload_Group"), _
             Array(msoControlButton, msoButtonIconAndCaption, "Computer", "Computer", "Upload Computer", "Upload_Computer"))), _
          Array(msoControlButton, msoButtonIconAndCaption, "Sort", SORT_AZ, "Sort List", "SortList"))
    End Sub

    Private Sub Workbook_Activate()
       On Error Resume Next
       Application.CommandBars.Item("AD Data Exchange").Enabled = True
    End Sub

    Private Sub Workbook_Deactivate()
       On Error Resume Next
       Application.CommandBars.Item("AD Data Exchange").Enabled = False
    End Sub

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
       subRemoveToolBar "AD Data Exchange"
    End Sub

    Within the VBA Project window, Modules, ToolBar module, the following code handles the creation and deletion of these custom toolbars:

    '                                                                  Created: 2010.05.18
    '                                                                  Updated: 2010.10.22
    '                                                                  Version: 1
    'Created by Michael Weigert @DSN: 252-8734, @E-Mail: Michael.Weigert@pac.dodea.edu
    'This module will create a custom toolbar to run VBA subroutines (macros).  The
    'temporary toolbar is created by calling Workbook_Open event proceedure within the
    'module for ThisWorkbook so the custom ToolBar is automatically created every time
    'the workbook opens.  A typical call to the subCreateToolBar to create a ToolBar menu
    'might look like:
    '
    'Private Sub Workbook_Open()
    '   Const ARROW_DOWN = 135
    '   Const ARROW_UP = 134
    '   'Const SORT_AZ = 2916
    '   Const SORT_AZ = 3157
    '   Const SORT_ZA = 3158
    '   Const USERS_AT_SERVER = 9927
    '   subRemoveToolBar "AD Data Exchange"
    '   subCreateToolBar "AD Data Exchange", Array( _
    '      Array(msoControlPopup, "Download", Array( _
    '         Array(msoControlButton, msoButtonIconAndCaption, "All", USERS_AT_SERVER, "Download All", "Download_All"), _
    '         Array(msoControlButton, msoButtonIconAndCaption, "User", "User", "Download User", "Download_User"), _
    '         Array(msoControlButton, msoButtonIconAndCaption, "Group", "Group", "Download Group", "Download_Group"), _
    '         Array(msoControlButton, msoButtonIconAndCaption, "Computer", "Computer", "Download Computer", "Download_Computer"))), _
    '      Array(msoControlPopup, "Upload", Array( _
    '         Array(msoControlButton, msoButtonIconAndCaption, "All", USERS_AT_SERVER, "Upload All", "Upload_All"), _
    '         Array(msoControlButton, msoButtonIconAndCaption, "User", "User", "Upload User", "Upload_User"), _
    '         Array(msoControlButton, msoButtonIconAndCaption, "Group", "Group", "Upload Group", "Upload_Group"), _
    '         Array(msoControlButton, msoButtonIconAndCaption, "Computer", "Computer", "Upload Computer", "Upload_Computer"))), _
    '      Array(msoControlButton, msoButtonIconAndCaption, "Sort", SORT_AZ, "Sort List", "SortList"))
    'End Sub

    Sub subCreateToolBar(varToolBar, arrToolBarButtonDefs)
       'Takes ToolBar name as the first parameter and an array of ToolBar definition arrays as the second.
       'Each ToolBarButton definition array has the following elements:
       '   Type: is any of a collection of over two dozen different types where the complete list can be
       '   seen within Object Explorer as members under the msoControlType class, with the most typical
       '   selections listed below as:
       '      msoControlPopup
       '      msoControlButton
       '      msoControlComboBox
       '   Style: is one of the one of the styles listed below as can be seen within Object Explorer as
       '   members under the msoButtonStyle class.
       '      msoButtonAutomatic
       '      msoButtonCaption
       '      msoButtonIcon
       '      msoButtonIconAndCaption
       '      msoButtonIconAndCaptionBelow
       '      msoButtonIconAndWrapCaption
       '      msoButtonIconAndWrapCaptionBelow
       '      msoButtonWrapCaption
       '   Caption: for the name of the button
       '   FaceID: for displayed icon
       '   ToolTipText: for displayed text during mouse over, if empty string then same as caption
       '   OnAction: for when button is clicked to identify the called subroutine
       'This code could be expanded to handle more ToolBarButton properties, the complete list of properties
       'can be seen within the Object Explorer under CommandBarButton.
       If IsObject(varToolBar) Then
          Set objToolBar = varToolBar
       Else
          strToolBarName = varToolBar
          On Error Resume Next
          Set objToolBar = CommandBars.Item(strToolBarName)
          On Error GoTo 0
          If Not IsEmpty(objToolBar) Then
             'Named ToolBar already exists, no action necessary.
             Exit Sub
          Else
             'Create and position named ToolBar docked to the right of Standard ToolBar.
             Set objToolBar = CommandBars.Add(Name:=strToolBarName, Position:=msoBarTop, Temporary:=True)
             objToolBar.Left = CommandBars("Standard").Left + CommandBars("Standard").Width
             objToolBar.RowIndex = CommandBars("Standard").RowIndex
          End If
       End If
       'Process ToolBar Controls
       For Each arrToolBarButtonDef In arrToolBarButtonDefs
          If arrToolBarButtonDef(0) = msoControlPopup Then
             Set objControlPopup = objToolBar.Controls.Add(Type:=msoControlPopup)
             objControlPopup.Caption = arrToolBarButtonDef(1)
             'Recursive call to create any number of nested submenus.
             subCreateToolBar objControlPopup, arrToolBarButtonDef(2)
          Else
             Set objCmdButton = objToolBar.Controls.Add(Type:=arrToolBarButtonDef(0))
             With objCmdButton
                .Style = arrToolBarButtonDef(1)
                .Caption = arrToolBarButtonDef(2)
                If IsNumeric(arrToolBarButtonDef(3)) Then
                   .FaceId = arrToolBarButtonDef(3)
                Else
                
               
                   'Set objIcon = ThisWorkbook.Worksheets("FaceIcon").Shapes(arrToolBarButtonDef(3))
                   'Set objPicture = LoadPicture(ThisWorkbook.Worksheets("FaceIcon").Shapes(arrToolBarButtonDef(3)))
                   'Set objPicture = ThisWorkbook.Worksheets("FaceIcon").Shapes(arrToolBarButtonDef(3)).Picture
                   'Set objPicture = ThisWorkbook.Worksheets("FaceIcon").Shapes(arrToolBarButtonDef(3)).Item
                  
               
                   ThisWorkbook.Worksheets("FaceIcon").Shapes(arrToolBarButtonDef(3)).Copy
                   .PasteFace
                   'Microsoft KB Articles 288771, 286460, 840872
                   '.Picture = ThisWorkbook.Worksheets("FaceIcon").Shapes(arrToolBarButtonDef(3))
                   '.Picture = ThisWorkbook.Worksheets("FaceIcon").Shapes(arrToolBarButtonDef(3)).Picture
               
                
                End If
                .TooltipText = arrToolBarButtonDef(4)
                '.OnAction = arrToolBarButtonDef(5)
                .OnAction = "'" & ThisWorkbook.Name & "'!" & arrToolBarButtonDef(5)
             End With
          End If
       Next
       objToolBar.Visible = True
    End Sub

    Sub subRemoveToolBar(strToolBarName)
       On Error Resume Next
       Set objToolBar = CommandBars.Item(strToolBarName)
       On Error GoTo 0
       If Not IsEmpty(objToolBar) Then
          objToolBar.DELETE
       End If
    End Sub

    Function DisplayGraphicName()
       'Execute the DisplayGraphicName function in the Immediate window pane
       'and then use the graphic's name to execute code similar to the following:
       '   ActiveSheet.Shapes("Picture 43").Name = "My Computer"
       'Then confirm the name change by executing DisplayGraphicName again.
       'For Each objShape In ActiveSheet.Shapes
       For Each objShape In ThisWorkbook.Sheets("FaceIcon").Shapes
          Debug.Print objShape.Name
       Next
    End Function

    'Sub ShowFaceIDs(intStart As Integer)
    Sub ShowFaceIDs(intStart)
       'http://www.ozgrid.com/forum/showthread.php?t=130749
       Dim NewToolbar As CommandBar
       Dim NewButton As CommandBarButton
       'Dim intIndex 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)
       
       'Change the range of values to see different FaceIDs as all faces cannot be displayed at one time.
       'A range of ID's for a 1000 at a time works OK but 2000 crashes Excel.  By viewing a 1000 Faces at
       'a time, it was determined that there were a good density of faces within all ranges between 0000
       'to 7999 and no faces within 8000 to 8999, but more from 9000 to 9999, and a few within 10000 to
       '10999 with the last being 10037.  No more faces were see beyond 10037 after looking at 11000 to
       '11999 and 12000 to 12999.  All of the button face icons for all Office products seemed to be included
       'within this index.
       For intIndex = intStart To intStart + 999
          Set NewButton = NewToolbar.Controls.Add _
          (Type:=msoControlButton, ID:=2950)
          NewButton.FaceId = intIndex
          NewButton.Caption = "FaceID = " & intIndex
       Next
      
       'NewToolbar.Width = 600    'Produces 25 ToolBar buttons per row.
       'NewToolbar.Width = 1200   'Produces 51 ToolBar buttons per row.
       'NewToolbar.Width = 1150   'Produces 49 ToolBar buttons per row.
       NewToolbar.Width = 1175   'Produces 50 ToolBar buttons per row.
       NewToolbar.Visible = True
    End Sub

    Private Sub CreateCommandBar()
       'Example of programatic toolbar creation found through internet search.
       'http://scriptorium.serve-it.nl/view.php?sid=14
       Dim myCB As CommandBar
       Dim myCBtn1 As CommandBarButton
       Dim myCBtn2 As CommandBarButton
       Dim myCPup1 As CommandBarPopup
       Dim myCPup2 As CommandBarPopup
       Dim myCP1Btn1 As CommandBarButton
       Dim myCP1Btn2 As CommandBarButton
      
       ' Delete the commandbar if it exists already
       On Error Resume Next
       Application.CommandBars("Example").DELETE
      
       ' Create a new Command Bar
       Set myCB = CommandBars.Add(Name:="Example", Position:=msoBarFloating)
      
       ' Add button 1 to this bar
       Set myCBtn1 = myCB.Controls.Add(Type:=msoControlButton)
       With myCBtn1
          .Caption = "1st level Cap."
          .Style = msoButtonCaption   '<- will force the caption text to show on your button
       End With
      
       ' Add popup menu 1 to this bar
       Set myCPup1 = myCB.Controls.Add(Type:=msoControlPopup)
       myCPup1.Caption = "Statistic"
      
       ' Add button 1 to popup menu 1
       Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
       With myCP1Btn1
          .Style = msoButtonAutomatic
          .FaceId = 487
       End With
      
       ' Add button 2 to popup menu 1
       Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
       With myCP1Btn1
          .Caption = "Click me!"
          .Style = msoButtonIconAndCaption
          .FaceId = 59
          .OnAction = "subItWorks"
       End With
     
       ' Add a second button to this bar
       Set myCBtn2 = myCB.Controls.Add(Type:=msoControlButton)
       With myCBtn2
          .FaceId = 17  ' <- Face Id 17 is a barchart icon
          .Caption = "Descriptive stat"
       End With
      
       ' Show the command bar
       myCB.Visible = True
    End Sub

    Private Sub subItWorks()
       'http://scriptorium.serve-it.nl/view.php?sid=14
       MsgBox ("Eureka, it works!")
    End Sub

     



    Friday, October 28, 2011 7:15 AM
  • Yesterday, the circumstances that I needed came up where I was able to reproduce the PasteFace problem for myself, I needed to perform some updates to Active Directory, and it was then that I discovered how to reliably reproduce the problem and identify the cause.  The problem is not within my coding given within the last post but rather a permissions issue caused by making use of RunAs, where the user is logged into the desktop with normal user account, but launches the Excel Application with RunAs with a more privileged account, one that has sufficient privilege to make changes to Active Directory.  The PasteFace method, always succeeds when only one user account is involved, when RunAs is not used, but fails when running the Excel application with alternate credentials using RunAs.  The failure occurs while attempting to use the clipboard, as there appears to be a user rights issue as to which account can properly access the clipboard object.  This Excel Application is designed to make it possible for the user to download the properties for the users, groups, and computers, make changes to properties within Excel, and then upload those changes back into Active Directory.  A normal user account has sufficient privilege to download, but the RunAs with an administrative account is needed for sufficient privilege to use the Upload feature to commit any changes made within Excel back into Active Directory.

    As the logged into desktop with a user account and RunAs alternate credentials with a privileged account scenario is unlikely for most applications, with my strange example being a likely uncommon case, I will close this thread as being answered with Bernie's suggestion, and open a new thread with a more specific question for my special circumstance, “Can A Standard Picture Handle Reference Be Created For A Shape On An Excel Worksheet?”.

     

    Tuesday, November 1, 2011 2:54 AM

  • re:  "but I could not find is a Microsoft Office Face ID showing a computer within the collection"

    Late to the game, but for what it is worth, FaceID  69 shows a computer monitor.
    '---
    Jim Cone
    Portland, Oregon USA
    http://www.mediafire.com/PrimitiveSoftware
    (Display FaceIDs add-in - in the free folder)
    Tuesday, January 3, 2012 1:37 PM