cyan Snowman on black background drawn by Access Ms Access Gurus

If you are helped, please return the favor and help support this site, thank you. Merry Christmas

Home Articles Code Tools

Draw a Snowman in Access

Draw a Snowman! Make your Access reports more festive. Change colors to indicate different things. VBA procedure that's easy to call from code behind your reports. Store colors you want to use in a table to make things more flexible. If you can imagine it, Access can do it.

Send the report object, top center coordinate and height for the snowman. Optionally, you can choose colors for snowman, hat, buttons, eyes, and snowman outline color.

The code that does the drawing is all in one module that you can easily import into your projects. The snowman uses Circle and Line methods.

Show a Snowman on an Access report

Quick Jump

Download Try it VBA Reference Backstory Share Donate

Goto Top  

Download

Download zipped BAS file you can import into your Access projects: bas_Draw_Snowman_s4p.zip

Download zipped ACCDB file with sample data, a module, and 2 sample reports: Draw_Snowman_s4p__ACCDB.zip

If you have trouble with a download, you may need to unblock the ZIP file, aka remove Mark of the Web, before extracting the file. Here are steps to do that: https://msaccessgurus.com/MOTW_Unblock.htm

Goto Top  

Try it yourself

There are 2 sample reports you can play around with

Goto Top  

VBA

Standard module 

'*************** Code Start ***************************************************
' Purpose  : draw a Snowman on an Access report
'             specify center top coordinate and height
'             optionally set colors for snowman, hat, buttons, eye, and outline
'           USES Circle and Line
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Draw_Snowman.htm
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
' bas_Draw_Snowman_s4p
'------------------------------------------------------------------------------
'           Global variables
'------------------------------------------------------------------------------
'comment if defined elsewhere
Public Const PI As Double = 3.14159 

Public Const gZero As Single = 0.0000001 

Public Const gColorOrange As Long = 38650  'RGB(250, 150, 0) 'carrot
Public Const gColorBrown As Long = 25750  'RGB(150, 100, 0 'stick arms
'------------------------------------------------------------------------------
'           Draw_Snowman_s4p
' send report object, top center coordinate and height
'------------------------------------------------------------------------------
Public Sub Draw_Snowman_s4p(poReport As Report _ 
      ,pXCenter As Single _ 
      ,pYTop As Single _ 
      ,pYHeight As Single _ 
   ,Optional pnColorSnowman As Variant = vbWhite _ 
   ,Optional pnColorHat As Variant = vbBlack _ 
   ,Optional pnColorButton As Variant = vbBlack _ 
   ,Optional pnColorEye As Variant = vbBlack _ 
   ,Optional pnColorLine As Variant = vbBlack _ 
   ) 
'221218, 19 s4p
'Draw a Snowman
'   measurements in twips

   On Error GoTo Proc_Err 
   'PARAMETERs
   '  poReport is the Report object
   '  pXCenter is x-coordinate of Snowman center
   '  pYTop is y-coordinate of Snowman top
   '  pYHeight is Snowman height
   
   '(Optional) -- long integer color values
   '     defined as Variant so they can be null
   '  pnColorSnowman Default is white
   '  pnColorHat Default is black
   '  pnColorButton Default is black
   '  pnColorEye Default is black
   '  pnColorLine Default is black
   
   If IsNull(pnColorSnowman) Then pnColorSnowman = vbWhite 
   If IsNull(pnColorHat) Then pnColorHat = vbBlack 
   If IsNull(pnColorButton) Then pnColorButton = vbBlack 
   If IsNull(pnColorEye) Then pnColorEye = vbBlack 
   If IsNull(pnColorLine) Then pnColorLine = vbBlack 

   'lots of variables since there are lots of objects
   Dim X As Single,Y As Single _ 
      ,x1 As Single,y1 As Single _ 
      ,x2 As Single,y2 As Single _ 
      ,yBottomMiddle As Single _ 
      ,yBellyMiddle As Single _ 
      ,yHeadMiddle As Single _ 
      ,sgRadiusBottom As Single _ 
      ,sgRadiusBelly As Single _ 
      ,sgRadiusHead As Single _ 
      ,sgRadiusButton As Single _ 
      ,sgRadiusEye As Single _ 
      ,sgRadiusSmile As Single _ 
      ,sgRadiusHat As Single _ 
      ,sgRadiusCarrot As Single _ 
      ,sgAngleCarrot1 As Single _ 
      ,sgAngleCarrot2 As Single _ 
      ,sgAngleSmile1 As Single _ 
      ,sgAngleSmile2 As Single _ 
      ,sgAngleArm As Single _ 
      ,sgAngleFinger As Single _ 
      ,sgAngle As Single 
      
   Dim sgLenArm As Single _ 
      ,sgLenFinger As Single _ 
      ,sgWidthFinger As Single _ 
      ,sgWidthScarf As Single _ 
      ,iArm As Integer _ 
      ,iFinger As Integer 

   '----------------------------- customize as desired
   sgRadiusBottom = pYHeight * 0.25  'bottom ball
   sgRadiusBelly = pYHeight * 0.2  'belly ball
      sgRadiusButton = sgRadiusBelly / 12 
   sgRadiusHead = pYHeight * 0.15  'head ball
      sgRadiusEye = sgRadiusHead / 8 
      
      sgRadiusCarrot = sgRadiusHead * 0.6 
      sgAngleCarrot1 = gZero 
      sgAngleCarrot2 = PI / 12 
      
      sgRadiusSmile = sgRadiusHead * 0.6 
      sgAngleSmile1 = PI * 1.3 
      sgAngleSmile2 = PI * 1.7 
   '-----------------------------

    With poReport 
      
      .ScaleMode = 1  'twips
      .DrawWidth = 1  'pixel

      .FillStyle = 0  'Opaque

      'bottom ball
      yBottomMiddle = Y + pYHeight - sgRadiusBottom 
      .FillColor = pnColorSnowman 
      'outline is black
      poReport.Circle (pXCenter,yBottomMiddle),sgRadiusBottom _ 
         ,pnColorLine,,,0.85 
      
      'belly ball - middle
      yBellyMiddle = Y + pYHeight / 2 
      .FillColor = pnColorSnowman 
      'outline is black
      poReport.Circle (pXCenter,yBellyMiddle),sgRadiusBelly _ 
         ,pnColorLine,,,0.85 

      'head ball - top
      yHeadMiddle = Y + pYHeight * 0.25 
      .FillColor = pnColorSnowman 
      'outline is black
      poReport.Circle (pXCenter,yHeadMiddle),sgRadiusHead _ 
         ,pnColorLine 
      
      'eyes
      Y = yHeadMiddle - sgRadiusHead * 0.1 
      'left eye
      X = pXCenter - sgRadiusHead / 3 
      .FillColor = pnColorEye 
      poReport.Circle (X,Y),sgRadiusEye,pnColorEye 
      'right eye
      X = pXCenter + sgRadiusHead / 4 
      poReport.Circle (X,Y),sgRadiusEye,pnColorEye 
            
      'smile
      .DrawWidth = sgRadiusEye / 16 
      
      poReport.Circle (pXCenter,Y) _ 
         ,sgRadiusSmile,vbBlack _ 
         ,sgAngleSmile1,sgAngleSmile2 
            
      'carrot nose
      .DrawWidth = 1 
      X = pXCenter - Cos(sgAngleCarrot1) * sgRadiusCarrot 
      Y = yHeadMiddle + sgRadiusHead / 5 
      .FillColor = gColorOrange 
      'negative angles are just indicators to fill
      poReport.Circle (X,Y) _ 
         ,sgRadiusCarrot,gColorOrange _ 
         ,-sgAngleCarrot1,-sgAngleCarrot2 
            
      'hat brim
      Y = yHeadMiddle - sgRadiusHead * 0.6 
      .FillColor = pnColorHat 
      poReport.Circle (pXCenter,Y),sgRadiusBelly,pnColorHat _ 
         ,,,0.2 
      
      ' hat barrel
      x1 = pXCenter - sgRadiusHead * 0.8 
      x2 = pXCenter + sgRadiusHead * 0.8 
      y1 = pYTop 
      y2 = pYTop + sgRadiusHead  '* 0.75
      poReport.Line (x1,y1)-(x2,y2),pnColorHat,BF 
      
      'buttons
      Y = yBellyMiddle 
      .FillColor = pnColorButton 
      poReport.Circle (pXCenter,yBellyMiddle) _ 
         ,sgRadiusButton,pnColorButton 
      'top
      Y = yBellyMiddle - sgRadiusBelly / 3 
      poReport.Circle (pXCenter,Y),sgRadiusButton,pnColorButton 
      'bottom
      Y = yBellyMiddle + sgRadiusBelly / 3 
      poReport.Circle (pXCenter,Y),sgRadiusButton,pnColorButton 
      'lower bottom
      Y = Y + sgRadiusBelly / 3 
      poReport.Circle (pXCenter,Y),sgRadiusButton,pnColorButton 
            
      '--------- arms
      For iArm = 1 To 2 
         'arm angle
         ' x1,y1 at shoulder
         If iArm = 1 Then 
            sgAngleArm = 7 * PI / 8 
            x1 = pXCenter - Cos(PI / 4) * sgRadiusBelly / 0.85 
            y1 = yBellyMiddle - (Sin(PI / 4) * sgRadiusBelly * 0.5) 
            sgLenArm = sgRadiusBelly * 0.8 
         Else   ' start higher
            sgAngleArm = PI / 3 
            x1 = pXCenter + Cos(PI / 3) * sgRadiusBelly * 1.5 
            y1 = yBellyMiddle - (Sin(PI / 3) * sgRadiusBelly * 0.5) 
            sgLenArm = sgRadiusBelly 
         End If 
         
         'at wrist
         x2 = x1 + Cos(sgAngleArm) * sgLenArm 
         y2 = y1 - Sin(sgAngleArm) * sgLenArm 
         .DrawWidth = sgRadiusButton / 6 
         poReport.Line (x1,y1)-(x2,y2),gColorBrown 
         
         '--------- fingers
         'palm of hand
         X = x2 
         Y = y2 
         For iFinger = 1 To 4 
            If iFinger = 1 Then  'thumb up
               sgAngleFinger = sgAngleArm - PI / 2 _ 
                  + (PI * (iArm - 1)) 
               sgWidthFinger = sgRadiusButton / 8 
               sgLenFinger = sgRadiusBelly / 6 
            ElseIf iFinger = 2 Then  'index finger
               sgAngleFinger = sgAngleArm - PI / 12 _ 
                  + IIf(iArm = 1,0,PI / 4) 
               sgWidthFinger = sgRadiusButton / 12 
               sgLenFinger = sgRadiusBelly / 3 
            Else 
               sgAngleFinger = sgAngleFinger _ 
                  + (PI / 6) * IIf(iArm = 1,1,-1) 
            End If 
            If iFinger = 4 Then 
               'shorter pinkie
               sgLenFinger = sgLenFinger * 0.75 
            End If 
            If iFinger = 1 Then 
               x2 = X + Cos(sgAngleFinger) * sgLenFinger 
               y2 = Y - Sin(sgAngleFinger) * sgLenFinger 
            Else 
               x2 = X + Cos(sgAngleFinger) * sgLenFinger 
               y2 = Y - Sin(sgAngleFinger) * sgLenFinger 
            End If 
            .DrawWidth = sgWidthFinger 
            poReport.Line (X,Y)-(x2,y2),gColorBrown 
         Next iFinger 
   
      Next iArm 
      
   End With 
      
Proc_Exit: 
   On Error GoTo 0 
   Exit Sub 
  
Proc_Err: 
   MsgBox Err.Description _ 
       ,, "ERROR " & Err.Number _ 
        &  "   Draw_Snowman_s4p"

   Resume Proc_Exit 
   Resume 
   
End Sub 
'*************** Code End *****************************************************

Goto Top  

Access report with a Snowman drawn with specified colors

rpt_Snowman_Detail_Sample

Code behind report to draw a Snowman based on status colors. 

'*************** Code Start CBR ***********************************************
' Purpose  : code behind rpt_Snowman_Detail_Sample
'              calls Draw_Snowman_s4p
'              draw a snowman with colors
'                 defined in a table 
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Draw_Snowman.htm
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'           Detail_Format
'------------------------------------------------------------------------------
Private Sub Detail_Format(Cancel As Integer,FormatCount As Integer) 
'221216 crystal
'draw Snowman in the detail section of a report
'	using colors specified (or not) in a table
   'CALLs
   '  Draw_Snowman_s4p
   
   Dim X As Single,Y As Single _ 
      ,sgHeight As Single 

   With Me 

      .ScaleMode = 1  'twips
      
      ' height for drawing
      sgHeight = 1.3 * 1440  'inch to twip
      
      'X center
      X = 1.5 * 1440  '1.5 inch
      'top
      Y = .ScaleTop 
      
      ' Call Draw_Snowman_s4p
      ' get color values from the record. Null will get default.
      Call Draw_Snowman_s4p(Me,X,Y,sgHeight _ 
         ,.ColrSnowman,.ColrSHat,.ColrButton,.ColrEye,.ColrLine) 
   
   End With 
End Sub 
'*************** Code End *****************************************************

Goto Top  

Access report with a Snowman on the page

rpt_Snowman_Page

Code behind report to draw a default snowman on a page. 

'*************** Code Start CBR ***********************************************
' Purpose  : code behind rpt_Snowmans_Page
'            calls Draw_Snowman_s4p
'              draw a Snowman on a page
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Draw_Snowmans.htm
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
'------------------------------------------------------------------------------
'           Report_Page
'------------------------------------------------------------------------------
Private Sub Report_Page() 
'221216 crystal
'draw a default snowman on the page
   'CALLs
   '  Draw_Snowman_s4p
      
   Dim X As Single,Y As Single _ 
      ,dx As Single,dy As Single _ 
      
   With Me 
      
      .ScaleMode = 1  'twips
      
      'width and height for drawing
      dx = .ScaleWidth 
      dy = .ScaleHeight - .PageFooterSection.Height 
      
      'left - center
      X = .ScaleLeft + dx / 2 
      'top
      Y = .ScaleTop 
   
   End With 
   
   'Call Draw_Snowman_s4p
   Call Draw_Snowman_s4p(Me,X,Y,dy) 
      
End Sub 
'*************** Code End *****************************************************
' Code was generated with colors using the free Color Code add-in for Access.

Goto Top  

Reference

Drawing Reference on MsAccessGurus

Report Draw Reference for VBA syntax and help for drawing on Access reports.

Circle method

Line method

DrawWidth property

FillColor property

FillStyle property

Sine function

Cosine function

Goto Top  

Backstory

Christmas is coming ... best wishes to you and your loved ones. if you live in a climate with snow, it's fun to make a real snowman! Snow angels are wonderful too ... and just looking at the beautiful snow.

Recently, I posted code to draw snowflakes on your Access reports. Different colors can be used to indicate various things in your data. And for something more practical for any season, look at drawing dynamic meters on your Access reports. If you can imagine it, Access can do it!

If you like this page, please let me know. Donations are needed and appreciated, thank you

Share with others

Here's the link for this page in case you want to copy it and share it with someone:

https://msaccessgurus.com/VBA/Draw_Snowman.htm

or in old browsers:
http://www.msaccessgurus.com/VBA/Draw_Snowman.htm

Get Help with Access and drawing

Let's connect and team-develop your application together. I teach you how to do it yourself. My goal is to empower you.

While we build something great together, I'll pull in code and features from my vast libraries as needed, cutting out lots of development time. I'll give you lots of links to good resources.

Do you want your reports to be more creative and visual? I'd love to help you. Email me at training@msAccessGurus.com

~ crystal

the simplest way is best, but usually the hardest to see

Goto Top