December 28, 2009
(Portions of this code are adapted from the book “Excel 2007 Power Programming with VBA“ )
This code sample is an Excel 2007 macro that extracts all of the named toolbar button pictures from Excel 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 EXCEL2007_TOOLBAR_PICTURES ( PICTURE_NAME VARCHAR2(60), PICTURE_SIZE NUMBER, PICTURE BLOB, PRIMARY KEY(PICTURE_NAME));
Download the ExcelImageList.doc file and save it using Microsoft Word as a Plain Text File with the name ExcelImageList.txt in the root of the C:\ drive.
We need to make certain that macro support is enabled in Excel 2007, by default it is disabled. Follow steps 1 through 3 to verify that the Developer tab appears at the top of the screen:
On the Developer tab, click the Visual Basic button. We need to add a reference to the Microsoft ActiveX Data Objects to allow the macro to interact with an Oracle database. From the Tools menu, select References…
Locate one of the recent releases of Microsoft ActiveX Data Objects, select it, then click OK.
Finally, we create the following macro:
Private Sub ExtractAllImages()
Dim i As Integer
Dim intResult As Integer
Dim intFileNum As Integer
Dim intFileNum2 As Integer
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 imgPicture As OLEObject
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("BuiltInImages").Delete
Sheets.Add
ActiveSheet.Name = "BuiltInImages"
DoEvents
Application.DisplayAlerts = True
If Len(Dir("C:\ExcelBuiltInImages", vbDirectory)) < 4 Then
'Create the folder to hold the exported pictures
MkDir "C:\ExcelBuiltInImages"
End If
'Create a temporary image object to hold the pictures from GetImageMso
Set imgPicture = Sheets("BuiltInImages").OLEObjects.Add(classtype:="Forms.Image.1", Left:=800, Top:=1, Width:=32, Height:=32)
With imgPicture.Object
.AutoSize = True
.BorderStyle = 0
End With
Err = 0
intFileNum = FreeFile
Open "C:\ExcelImageList.txt" For Input As #intFileNum
If Err <> 0 Then
intResult = MsgBox("Could not open the image list file." & vbCrLf & Error(Err), 16, "Excel Demo")
Exit Sub
End If
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 EXCEL2007_TOOLBAR_PICTURES (
' PICTURE_NAME VARCHAR2(60),
' PICTURE BLOB,
' PRIMARY KEY(PICTURE_NAME));
If Err = 0 Then
'Remove pictures that were previously brought in
strSQL = "DELETE FROM EXCEL2007_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 & " EXCEL2007_TOOLBAR_PICTURES"
dynData.Open strSQL, dbDatabase, adOpenKeyset, adLockOptimistic, adCmdText
'Process each of the toolbar picture names from the text file
Do While Not (EOF(intFileNum))
i = i + 1
'Read a toolbar picture name from the text file
Line Input #intFileNum, strName
Application.StatusBar = strName
'Set the picture in the temporary image object, and then save to disk
imgPicture.Object.Picture = Application.CommandBars.GetImageMso(strName, 32, 32)
SavePicture imgPicture.Object.Picture, "C:\ExcelBuiltInImages\temp.bmp"
'Create a new row in the table
dynData.AddNew
dynData("picture_name") = strName & ".bmp"
dynData("picture_size") = FileLen("C:\ExcelBuiltInImages\temp.bmp")
'Read the picture into the table
intFileNum2 = FreeFile
Open "C:\ExcelBuiltInImages\temp.bmp" For Binary As #intFileNum2
'Prepare a variable of byte data type to hold the picture read from disk
ReDim bytPicture(FileLen("C:\ExcelBuiltInImages\temp.bmp"))
Get #intFileNum2, , bytPicture
Close #intFileNum2
'Write the picture into the table and save the row
dynData.Fields("picture").AppendChunk bytPicture
dynData.Update
'Delete the picture from the folder
Kill "C:\ExcelBuiltInImages\temp.bmp"
Loop
Application.StatusBar = ""
dbDatabase.CommitTrans
dynData.Close
Close #intFileNum
'Remove the temporary image object
imgPicture.Delete
'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 & " EXCEL2007_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
ReDim bytPicture(snpData("picture_size"))
bytPicture = snpData("picture")
intFileNum2 = FreeFile
Open "C:\ExcelBuiltInImages\" & 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 20) * 36
sglY = Int((i - 1) / 20) * 36
'Create the shape object and load the picture that was saved from the image object
With Sheets("BuiltInImages").Shapes.AddShape(Type:=msoShapeRectangle, Left:=sglX, Top:=sglY, Width:=30, Height:=30)
.Line.Visible = False
.Fill.UserPicture "C:\ExcelBuiltInImages\" & snpData("picture_name")
.AlternativeText = snpData("picture_name")
End With
'Allow Excel to refresh the screen as every four rows complete
If i Mod 80 = 0 Then
Application.ScreenUpdating = True
DoEvents
Application.ScreenUpdating = False
End If
snpData.MoveNext
Loop
snpData.Close
End If
End If
Application.ScreenUpdating = True
Application.StatusBar = ""
dbDatabase.Close
'Clean up
Set snpData = Nothing
Set dynData = Nothing
Set dbDatabase = Nothing
Set imgPicture = 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. Once all of the pictures are stored in the database, a query is run to retrieve each of the pictures, create a file in ExcelBuiltInImages folder for that picture, and then display the picture in Excel. The screen is refreshed after every 80 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, rather than 32 pixels by 32 pixels – so the images may appear a bit “blocky”. The picture filenames are stored in 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