December 28, 2009
This code sample is an Excel 2003/2007 macro that extracts all of the named toolbar button pictures from Excel 2003/2007, transfers those pictures to an Oracle database (stored in a BLOB), and then retrieves each of the pictures and displays the pictures on an Excel worksheet.
First, we need to create a table to hold the pictures:
CREATE TABLE EXCEL2003_TOOLBAR_PICTURES ( PICTURE_NAME VARCHAR2(60), PICTURE_SIZE NUMBER, PICTURE BLOB, PRIMARY KEY(PICTURE_NAME));
See the instructions in the previous blog article to enable macro support in Excel 2007 and add a reference to the ActiveX Data Objects in Excel 2003 and above.
The Excel macro code follows:
Private Sub ExtractAllImages2003() 'Adapted from an example by John Walkenbach ' http://www.dailydoseofexcel.com/archives/2006/11/16/displaying-commandbar-faceid-images/ 'See also http://support.microsoft.com/kb/286460 Dim i As Integer Dim intResult As Integer Dim intFileNum2 As Integer Dim lngNumPics As Long Dim sglX As Single Dim sglY As Single Dim strName As String Dim strSQL As String Dim strDatabase As String Dim strUserName As String Dim strPassword As String Dim bytPicture() As Byte Dim tbNewToolbar As CommandBar Dim tbcNewControl As CommandBarButton Dim picPicture As stdole.IPictureDisp Dim picMask As stdole.IPictureDisp Dim snpData As New ADODB.Recordset Dim dynData As New ADODB.Recordset Dim dbDatabase As New ADODB.Connection On Error Resume Next 'Remove all of the previously created sheet Application.DisplayAlerts = False Sheets("BuiltInImages2003").Delete Sheets.Add ActiveSheet.Name = "BuiltInImages2003" 'Delete existing TempFaceIds toolbar if it exists Application.CommandBars("TempFaceIds").Delete 'Add an empty toolbar Set tbNewToolbar = Application.CommandBars.Add(Name:="TempFaceIds") 'Create an object to act as a command bar control Set tbcNewControl = tbNewToolbar.Controls.Add(Type:=msoControlButton) Application.DisplayAlerts = True If Len(Dir("C:\ExcelBuiltInImages2003", vbDirectory)) < 4 Then 'Create the folder to hold the exported pictures MkDir "C:\ExcelBuiltInImages2003" End If Err = 0 strDatabase = "MyDB" 'From tnsnames.ora strUserName = "MyUserID" strPassword = "MyPassword" 'Connect to the database 'Oracle connection string dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;" dbDatabase.ConnectionTimeout = 40 dbDatabase.CursorLocation = adUseClient dbDatabase.Open If (dbDatabase.State <> 1) Or (Err <> 0) Then intResult = MsgBox("Could not connect to the database. Check your user name and password." & vbCrLf & Error(Err), 16, "Excel Demo") End If 'The table definition 'CREATE TABLE EXCEL2003_TOOLBAR_PICTURES ( ' PICTURE_NAME VARCHAR2(60), ' PICTURE_SIZE NUMBER, ' PICTURE BLOB, ' PRIMARY KEY(PICTURE_NAME)); If Err = 0 Then 'Remove pictures that were previously brought in strSQL = "DELETE FROM EXCEL2003_TOOLBAR_PICTURES" dbDatabase.Execute strSQL dbDatabase.BeginTrans 'Prepare to add the new pictures to the database strSQL = "SELECT" strSQL = strSQL & " PICTURE_NAME," & vbCrLf strSQL = strSQL & " PICTURE_SIZE," & vbCrLf strSQL = strSQL & " PICTURE" & vbCrLf strSQL = strSQL & "FROM" & vbCrLf strSQL = strSQL & " EXCEL2003_TOOLBAR_PICTURES" dynData.Open strSQL, dbDatabase, adOpenKeyset, adLockOptimistic, adCmdText For i = 1 To 4400 'Maximum in Excel 2003 is around 10033 'Set the picture on the command bar control to picture number i tbcNewControl.FaceId = i 'Transfer the pictures from the command bar control to local variables Set picPicture = tbcNewControl.Picture Set picMask = tbcNewControl.Mask 'Save the pictures to disk strName = "FaceID " & Format(i, "0000") & ".bmp" Application.StatusBar = strName stdole.SavePicture picPicture, "C:\ExcelBuiltInImages2003\temp.bmp" 'Create a new row in the table dynData.AddNew dynData("picture_name") = strName dynData("picture_size") = FileLen("C:\ExcelBuiltInImages2003\temp.bmp") 'Read the picture into the table intFileNum2 = FreeFile Open "C:\ExcelBuiltInImages2003\temp.bmp" For Binary As #intFileNum2 'Prepare a variable of byte data type to hold the picture read from disk ReDim bytPicture(FileLen("C:\ExcelBuiltInImages2003\temp.bmp")) Get #intFileNum2, , bytPicture Close #intFileNum2 'Write the picture into the table and save the row dynData.Fields("picture").AppendChunk bytPicture dynData.Update 'Save the mask picture for the toolbar button stdole.SavePicture picMask, "C:\ExcelBuiltInImages2003\temp.bmp" strName = "FaceID " & Format(i, "0000") & " Mask.bmp" 'Create a new row in the table dynData.AddNew dynData("picture_name") = strName dynData("picture_size") = FileLen("C:\ExcelBuiltInImages2003\temp.bmp") 'Read the picture into the table intFileNum2 = FreeFile Open "C:\ExcelBuiltInImages2003\temp.bmp" For Binary As #intFileNum2 'Prepare a variable of byte data type to hold the picture read from disk ReDim bytPicture(FileLen("C:\ExcelBuiltInImages2003\temp.bmp")) Get #intFileNum2, , bytPicture Close #intFileNum2 'Write the picture into the table and save the row dynData.Fields("picture").AppendChunk bytPicture dynData.Update 'Free the memory ffrom the local variables Set picPicture = Nothing Set picMask = Nothing 'Allow Excel to process events every 160 pictures If i Mod 160 = 0 Then Application.ScreenUpdating = True DoEvents Application.ScreenUpdating = False End If Next i dbDatabase.CommitTrans dynData.Close 'Delete the picture from the folder Kill "C:\ExcelBuiltInImages2003\temp.bmp" 'Retrieve the pictures from the database and display in Excel i = 0 strSQL = "SELECT" & vbCrLf strSQL = strSQL & " PICTURE_NAME," & vbCrLf strSQL = strSQL & " PICTURE_SIZE," & vbCrLf strSQL = strSQL & " PICTURE" & vbCrLf strSQL = strSQL & "FROM" & vbCrLf strSQL = strSQL & " EXCEL2003_TOOLBAR_PICTURES" & vbCrLf strSQL = strSQL & "ORDER BY" & vbCrLf strSQL = strSQL & " PICTURE_NAME" snpData.Open strSQL, dbDatabase If Not (snpData.EOF) Then Do While Not (snpData.EOF) i = i + 1 Application.StatusBar = snpData("picture_name") 'Retrieve the picture from the database and write to a file intFileNum2 = FreeFile ReDim bytPicture(snpData("picture_size")) bytPicture = snpData("picture") Open "C:\ExcelBuiltInImages2003\" & snpData("picture_name") For Binary As #intFileNum2 Put #intFileNum2, , bytPicture Close #intFileNum2 'There will be 20 pictures across the page, so identify the top left position of the picture sglX = ((i - 1) Mod 40) * 18 sglY = Int((i - 1) / 40) * 18 'Create the shape object and load the picture that was saved from the image object With Sheets("BuiltInImages2003").Shapes.AddShape(Type:=msoShapeRectangle, Left:=sglX, Top:=sglY, Width:=16, Height:=16) .Line.Visible = False .Fill.UserPicture "C:\ExcelBuiltInImages2003\" & snpData("picture_name") .AlternativeText = snpData("picture_name") End With 'Allow Excel to refresh the screen as every four rows complete If i Mod 160 = 0 Then Application.ScreenUpdating = True DoEvents Application.ScreenUpdating = False End If snpData.MoveNext Loop snpData.Close End If End If Application.CommandBars("TempFaceIds").Delete Application.ScreenUpdating = True Application.StatusBar = "" dbDatabase.Close 'Clean up Set snpData = Nothing Set dynData = Nothing Set dbDatabase = Nothing End Sub
When the macro runs, it saves each of the built-in toolbar icons to a file named temp.bmp, and then inserts a row into the database table with the temp.bmp picture and the mask for the temp.bmp picture that will allow creating a semi-transparent button image. Once all of the pictures are stored in the database, a query is run to retrieve each of the pictures, create a file in the ExcelBuiltInImages2003 folder for that picture, and then display the picture in Excel. The screen is refreshed after every 160 pictures are displayed. Note that most of the built-in toolbar icons are designed to be viewed at a size of 16 pixels by 16 pixels, so the icons are extracted at that size. The picture filenames are written to the Alt Text property of each picture, which may be viewed by right-clicking a picture and selecting Size and Properties…
After the macro runs, the new worksheet will look something like the picture below:
Since the pictures are also saved to a file, they are ready to be used for other purposes:
Recent Comments