So I had cause to load an image file and query the colour of a pixel, so I needed some image processing code. I had encountered some code before but did not capture it for this blog. Investigating today I was depressed by the obscure way the Windows API worked in this regard, then to find that the Windows API declaration would need to change for 64-bit versions of VBA I rebelled. Instead, I reached for the .NET image classes and chose to export them from a C# class library using .NET/COM interop. Life is much simpler now.
Below is some code that calls into the C# class library, the source for which can be found on this counterpart blog post. Together these programs allow a picture to written to Excel cells like this...
Option Explicit
Sub Test()
DumpPictureToCells "N:\stackoverflowicon.png", False
'DumpPictureToCells "N:\number.png", True
End Sub
Sub DumpPictureToCells(ByVal sFileName As String, ByVal bIsAlphaMask As Boolean)
Dim oBitMap As ImageToByteArray.BitMap
Set oBitMap = New ImageToByteArray.BitMap
Dim bSU As Boolean
bSU = Application.ScreenUpdating
Application.ScreenUpdating = False
Sheet1.Cells.Clear
oBitMap.LoadImage sFileName
Dim x As Long, y As Long
For x = 0 To oBitMap.Width - 1
For y = 0 To oBitMap.Height - 1
Dim col As ImageToByteArray.Colour
Set col = oBitMap.GetPixel(x, y)
Dim rng As Excel.Range
Set rng = Sheet1.Cells(y + 1, x + 1)
If bIsAlphaMask Then
rng.Interior.Color = RGB(256 - col.A, 256 - col.A, 256 - col.A)
Else
rng.Interior.Color = RGB(col.R, col.G, col.B)
End If
Next
Next
Application.ScreenUpdating = bSU
End Sub
Private Function ResizeCellsToBeSquare()
Dim sngColWidth
sngColWidth = 2.14 '* based on experimentation
Dim lColLoop As Long
For lColLoop = 1 To Sheet1.UsedRange.Columns.Count
Dim rngCell As Excel.Range
Set rngCell = Sheet1.Cells(1, lColLoop)
rngCell.EntireColumn.ColumnWidth = sngColWidth
Next
End Function
P.S. During the WinAPi investigation I came across this excellent website mvps.org
No comments:
Post a Comment