VBA Intermediate Course work – Aeternus Consulting Singapore

Intermediate VBA course work singapore

Beautiful Art pixelated with VBA Programming.

Intermediate VBA Course Work

This is a VBA programming project to assemble a working Excel VBA application from scratch!

Project Duration (hours)

1/2

Location:
Anywhere with Office 365 installed.

Venue:
Anywhere with Office 365 installed.

Dates:
Whenever you feel like it.

Funding:
Cost

Introduction to the Intermediate VBA course work

You will need basic VBA programming knowledge to complete this intermediate level VBA course work. Full VBA codes are provided but instructions will be sparse. Your challenge is to assemble a working VBA application in Excel to demonstrate a basic knowledge of VBA programming in Excel. The completed Excel VBA application will import an image and create a worksheet of colored cells to replicate the image. You will start from an empty Excel workbook.

Prerequisite for Advanced VBA course work

Our Advanced VBA workshops are thematic, project-oriented aimed at a very specific outcome that allows you to demonstrate high VBA language proficiency with confidence to employers and interviewers.

They are designed to be quickly delivered to students with high hand-on ability from the get-go. Hence, we require our attendees to complete this intermediate VBA course work as a prerequisite for the Advanced VBA master classes. If these VBA codes look unfamiliar then we would recommend that you consider our Beginner VBA course as a start.

Insert the first VBA code module

Start from an empty Excel workbook.
Go to the Visual Basic Editor.
Insert a VBA code module and transfer the following VBA codes.
Assign the Browse_File() subroutine to the shortcut key “Ctrl+Shift+A“.

				
					Option Explicit

'*****************************************************************
'Purpose: insert an image onto the active worksheet
'*****************************************************************
Sub Browse_File()
    'Step 1: delete any existing shapes on the active worksheet
    Dim shpImage As Shape
    For Each shpImage In ActiveSheet.Shapes
        shpImage.Delete
    Next
    
    'Step 2: set all cells to no fill
    With ActiveSheet.Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    'Step 3: make square grids
    Cells.EntireColumn.ColumnWidth = 0.5 'adjust this value to make square grids
    Cells.EntireRow.RowHeight = 5 'adjust this value to make square grids
    
    'Step 4: ask user to browse for a file
    Dim vntFileNameFull As Variant
    On Error Resume Next
    ChDir ThisWorkbook.Path 'change current directory to workbook location
    On Error GoTo 0
    vntFileNameFull = Application.GetOpenFilename("Image files(*.jpg;*.png;*.gif;*.bmp),*.jpg;*.png;*.gif;*.bmp", , "Select an image file") 'file browser
    If (vntFileNameFull = False) Then 'if cancel button pressed
        End 'stop everything
    End If
    
    'Step 5: insert the image as a shape, at top left, orig size
    Set shpImage = ActiveSheet.Shapes.AddPicture( _
        Filename:=vntFileNameFull, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=0, _
        Top:=0, _
        Width:=-1, _
        Height:=-1)
End Sub

This is the logic in the first VBA module.

Step 1: A For Each loop to delete any existing shapes at the start of this subroutine.
Step 2: Fill all cells in the current worksheet to no colour. These statements can be created with the Excel Macro recorder.
Step 3: We want to create square cells in the worksheet. Each cell will represent 1 pixel. You can adjust the width and height values to create a size to your liking.
Step 4: Application.GetOpenFile method will open a file browser to select an appropriate image file.
Step 5: With the filename obtained in step 4, we paste the image as a shape using ActiveSheet.Shapes.AddPicture method.

Insert the second VBA code module

Insert another VBA code module and transfer the following VBA codes.
Assign the GetImagePixelStatistics() subroutine to the shortcut key “Ctrl+Shift+B“.

				
					Option Explicit

'Step 1:declare some Windows APIs
#If VBA7 Then
    'for 64-bit Excel
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As LongPtr) As LongPtr
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As LongPtr
#Else
    Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#End If

'Step 2: declare some public variables to store some image stats
Public lgImageLeftPx As Long
Public lgImageTopPx As Long
Public lgImageRightPx As Long
Public lgImageBtmPx As Long
Public lgImageWidthPx As Long
Public lgImageHeightPx As Long


'*****************************************************************
'Step 3:
'Purpose: get the screen dpi. ie: how many pixels in an inch on the screen
'*****************************************************************
Function ScreenPixelPerInch() As Long
    Const LOGPIXELSX = 88  'parameter for GetDeviceCaps: Ask for Number of pixels per logical inch along the screen width.
    Dim lgDevContext As Long 'device context for the screen
    lgDevContext = GetDC(0)
    ScreenPixelPerInch = GetDeviceCaps(lgDevContext, LOGPIXELSX) 'device capability for Number of pixels per logical inch
    lgDevContext = ReleaseDC(0, lgDevContext)
End Function

'*****************************************************************
'Step 4:
'Purpose: calculate points to pixels. ie: 72 points per inch in Excel
'*****************************************************************
Function ExcelPointToScreenPixel(lgPoint As Long) As Long
    ExcelPointToScreenPixel = lgPoint / 72 * ScreenPixelPerInch
End Function

'*****************************************************************
'Step 5:
'Purpose: get the image pixel width, height.
'*****************************************************************
Sub GetImagePixelStatistics()
    'Step 6: check for image
    If ActiveSheet.Shapes.Count <> 1 Then
        MsgBox ("Please have only 1 image on the worksheet")
        End
    End If
    
    'Step 7: get reference to Excel's window
    Dim wndExcel As Window
    Set wndExcel = ActiveSheet.Cells(1, 1).Parent.Parent.Windows(1)

    'Step 8: get pixel locations of the Excel Window
    Dim lgExcelWindowLeftPx As Long
    Dim lgExcelWindowTopPx As Long
    lgExcelWindowLeftPx = wndExcel.PointsToScreenPixelsX(0)
    lgExcelWindowTopPx = wndExcel.PointsToScreenPixelsY(0)

    'Step 9: get reference to the image
    Dim shpImage As Shape
    Set shpImage = ActiveSheet.Shapes(1)

    'Step 10: image left pixel location
    lgImageLeftPx = ExcelPointToScreenPixel(shpImage.Left * wndExcel.Zoom / 100) + lgExcelWindowLeftPx

    'Step 11: image top pixel location
    lgImageTopPx = ExcelPointToScreenPixel(shpImage.Top * wndExcel.Zoom / 100) + lgExcelWindowTopPx
    
    'Step 12: image width in pixels
    lgImageRightPx = ExcelPointToScreenPixel(shpImage.Width * wndExcel.Zoom / 100) + lgImageLeftPx
    
    'Step 13: image height in pixels
    lgImageBtmPx = ExcelPointToScreenPixel(shpImage.Height * wndExcel.Zoom / 100) + lgImageTopPx
     
    'Step 14: image width in pixels
    lgImageWidthPx = lgImageRightPx - lgImageLeftPx
    
    'Step 15: image height in pixels
    lgImageHeightPx = lgImageBtmPx - lgImageTopPx
    
    Debug.Print "width:"; lgImageWidthPx, "height"; lgImageHeightPx; "total:"; lgImageWidthPx * lgImageHeightPx, _
    "left:"; lgImageLeftPx; "right:"; lgImageRightPx; "top:"; lgImageTopPx; "btm:"; lgImageBtmPx; "zoom:"; wndExcel.Zoom
End Sub

The module logic in the second VBA module in English.

Step 1: This module needs 3 Windows APIs to obtain screen pixel information. You can look at our popular Windows API blog article for more information.
Step 2: We create 6 public VBA variables to store some pixel location for the 4 sides of an image, the width and height of an image in pixels. No mysteries here.
Step 3: The VBA language does not provide any information about the pixel density of your screen. We will use the GetDeviceCaps Windows API. The VBA codes are standard fare with a bit of web research. The typical VBA programmer don’t fret about this.
Step 4: All graphics and shapes displayed in the Excel window are measured in “Points Per Inch”. Microsoft Excel have decided that there are 72 “Points” in an inch. This step calculates the number of pixel when we deal with an image “Point” width and “Point” height.
Step 5: This sub will measure the image dimensions (top, left, right, bottom, etc) in pixels and store them in public variables (in step 2).
Step 6: We will only allow 1 image to exist on a worksheet. If this requirement is not satisfied, we will stop the application.
Step 7: We need a reference to the window for the Excel application to find the pixel location of the “top-left” window corner and the “zoom” level.
Step 8: Using the window reference in step 7, PointsToScreenPixelsX(0) and PointsToScreenPixelsY(0) tell us the pixel location of the top-left corner of the Excel window on the physical screen.
Step 9-10: We will obtain the image Shape dimensions. They will be in “Points per Inch” which we convert into pixels and store them in public variables (in step 2).

Insert the third VBA code module

Insert another VBA code module and transfer the following VBA codes.
Assign the ScanImage() subroutine to the shortcut key “Ctrl+Shift+C“.

				
					Option Explicit

#If VBA7 Then
    Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hDC As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr) As LongPtr
#Else
    Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
#End If

'*****************************************************************
'Purpose:
'*****************************************************************
Sub ScanImage()
    'set all cells to no fill
    With ActiveSheet.Cells.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveSheet.Cells(1, 1).Activate
    
    'image stats stored in public variables
    Call GetImagePixelStatistics

    'give warning for big image
    If lgImageWidthPx * lgImageHeightPx > 10000 Then
        Dim intReply As Integer
        intReply = MsgBox("The image is more than 10000 pixels, it can take longer to generate. Proceed?", vbYesNo)
        If intReply = vbNo Then
            End
        End If
    End If

    'get device context for the screen
    Dim lgDevContext As Long
    lgDevContext = GetDC(0)
    
    'scan the image
    Dim lgHortPxCurr As Long, lgVertPxCurr As Long
    Dim lgPxColour As Long
    Dim lgRowCurr As Long, lgColCurr As Long
    lgRowCurr = 1
    lgColCurr = 1
    For lgVertPxCurr = lgImageTopPx To lgImageBtmPx
        For lgHortPxCurr = lgImageLeftPx To lgImageRightPx
            lgPxColour = GetPixel(lgDevContext, lgHortPxCurr, lgVertPxCurr)
            Call ColourCell(Cells(lgRowCurr, lgColCurr), lgPxColour)
            lgColCurr = lgColCurr + 1 'increment cell column
        Next
        lgColCurr = 1 'reset cell column
        lgRowCurr = lgRowCurr + 1 'increment cell row
        DoEvents
    Next
    
    'release device context
    lgDevContext = ReleaseDC(0, lgDevContext)
    'MsgBox "Done!"
End Sub

'*****************************************************************
'Purpose: colour a cell
'*****************************************************************
Sub ColourCell(rngCell As Range, lgColour As Long)
    Dim byteRed As Byte
    Dim byteGreen As Byte
    Dim byteBlue As Byte
    byteRed = lgColour And &HFF&
    byteGreen = (lgColour And &HFF00&) / 256
    byteBlue = (lgColour And &HFF0000) / 65535
    rngCell.Interior.Color = RGB(byteRed, byteGreen, byteBlue)
End Sub

Almost done with Intermediate VBA Course work! Test the VBA app.

Save the Excel workbook as an XLSM or XLSB file.
Shortcut key “Ctrl+Shift+A” allows you to browse an image file and paste it into a worksheet.
Shortcut key “Ctrl+Shift+B” allows you to see the dimensions and size of the image in the VBE immediate window.
Shortcut key “Ctrl+Shift+C” will scan the image pixel by pixel and generate the appropriate cells in the current worksheet.

Key take aways for Intermediate VBA course work

Developing any VBA subroutine takes immense patience.
Learn to break down a problem into tiny problems and determine whether the VBA language is able to solve it. The build your way up gradually to solve the entire problem.
It is often productive to think about your solutions in English and translate the logic into the VBA language!

Training Provider

VBA is a deep computer language. Like learning any language, instructor quality determines how much you get out of the classroom. Learn from real practitioners with over 15 years of development & consulting experience. Unlike other centers, we keep our classes small so that there are real discussions about real problems.

Course Trainer

Derek Leong is a fellow Consultant at Aeternus. He has a broad background in marketing, business analysis & software development. When he conducts Excel and other courses, he combines technical expertise and business experience with a creative bent.

I must say that this is one of the best workshops that I have attended. Eventhough the course is for Basic VBA, I see that some advance tips were shared during the class. A lot of best pratices were shared by Derek which helps solve problems encountered at work. Derek as instructor is really exceptional. He was very lively from morning to afternoon. He was knowledgeable in the subject matter and was patient with his students. He was even willing to help out in my current project! Plus points for the classroom setting. It was very conducive for learning. And you can have all the coffee that you want-what more can I say! Aeternus consulting should be the premiere center for all your MS Office needs. Two thumbs up!

About Aeternus Consulting

Best Excel courses in Singapore conducted by expert consultants

Aeternus Consulting is the premier training centre in Singapore for Excel Courses – Basic Excel, Advanced Excel and Excel VBA Macro courses. For more Microsoft Excel training courses, please visit our Excel training page.

Aeternus Consulting is now on Instagram! So take a look and follow us on Instagram.