Thursday, 26 April 2018

C# - VBA - COM - For image processing ditch WinAPI/GDI and use .NET instead

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

Thursday, 19 April 2018

VBA - Use PivotTable and SpecialCells(xlCellTypeBlanks) to get totals rows

Twenty or so years ago when I learnt Excel VBA I read a book called Excel VBA Step-by-step, it was full of instructive examples as you can imagine. One example stuck with me, it used a pivottable to take some rows, do the totalling and finally format the totals back into normalised rows by pulling a trick using Excel.Range's method SpecialCells(xlCellTypeBlanks)

It remains the only use case for SpecialCells(xlCellTypeBlanks) I have encountered.


Option Explicit

Sub Test()
    Test_FillInPivotBlanks_InitialiseSheet_RunOnce
    Test_FillInPivotBlanks_CreatePivot_RunOnce
    Test_FillInPivotBlanks
End Sub

Private Function WorkingSheet() As Excel.Worksheet
    Set WorkingSheet = Sheet1 '* add as required
End Function

Sub Test_FillInPivotBlanks_InitialiseSheet_RunOnce()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet
    sh.Cells.Clear
    
    Dim vSeed As Variant
    vSeed = [{"Colour","Shape","Number";"Red","Triangle",2;"Red","Triangle",22;"Red","Square",3;"Red","Circle",8;"Green","Square",13;"Blue","Circle",21}]
    
    sh.Range("a1:c7").Value2 = vSeed
End Sub

Sub Test_FillInPivotBlanks_CreatePivot_RunOnce()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet

    Dim rng As Excel.Range
    Set rng = sh.Range("a1").CurrentRegion
    rng.Select
    
    Dim rngDest As Excel.Range
    Set rngDest = sh.Range("f1")
    rngDest.CurrentRegion.Delete
    
    Dim pvtCache As Excel.PivotCache
    Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rng.Address, Version:=xlPivotTableVersion10)
        
    Dim pvtTable As Excel.PivotTable
    Set pvtTable = pvtCache.CreatePivotTable( _
        TableDestination:=sh.Name & "!R1C6", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion10)
    
    pvtTable.ColumnGrand = False
    pvtTable.RowGrand = False
    
    Dim pvtfldCol As Excel.PivotField
    Set pvtfldCol = pvtTable.PivotFields("Colour")
    pvtfldCol.Orientation = xlRowField
    pvtfldCol.Position = 1

    With pvtTable.PivotFields("Shape")
        .Orientation = xlRowField
        .Position = 2
        
    End With
    pvtTable.AddDataField pvtTable.PivotFields("Number"), "Sum of Number", xlSum
    
    pvtTable.PivotFields("Colour").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    

End Sub

Sub Test_FillInPivotBlanks()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet

    Dim rngDest As Excel.Range
    Set rngDest = sh.Range("f1").CurrentRegion
    
    rngDest.Copy
    sh.Range("J1").PasteSpecial xlPasteValues

    Application.CutCopyMode = False

    Dim rngCopied As Excel.Range
    Set rngCopied = sh.Range("J1").CurrentRegion

    Dim rngBlanks As Excel.Range
    Set rngBlanks = rngCopied.SpecialCells(xlCellTypeBlanks)
    
    Dim rngBlankLoop As Excel.Range
    For Each rngBlankLoop In rngBlanks
        Debug.Assert IsEmpty(rngBlankLoop)
        rngBlankLoop.FormulaR1C1 = "=R[-1]C"
    Next rngBlankLoop

End Sub






Wednesday, 18 April 2018

COM - Windows - WOW32_64 - Isolate legacy 32-bit component from 64-bit clients by using a surrogate process

On StackOverflow, the problem of 64bit vs 32bit for VBA programming arises quite often on SO. I can't claim this will be a definitive blog post but here I gather some thoughts and links that I believe would lead to generic solution.

Firstly, Microsoft has not left 32-bit components completely hanging. It does have an inter-operability technology for this, its called Windows on Windows (WOW), this was invented for the 16bit vs 32bit years ago. WOW also exists for the 32-bit vs 64-bit, it sometimes called Wow64_32 to distinguish from previous generation.

You would have thought Wow64_32 would be enough for 32-bit components to be inter-operable in-process for 64 bit clients. Unfortunately one cannot load win32 modules into a win64 process space. Instead one must use a surrogate as outlined in this article Registering the DLL Server for Surrogate Activation. Using a surrogate process means one can keep 32-bit components separate from 64-bit clients.