Draw a Christmas Tree in Access

Quick Jump

Download

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

Download zipped ACCDB file with sample data, a module, and 2 sample reports: Draw_Christmas Tree_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

Try it yourself

There is a sample report to draw a tree on the page

Video

watch on YouTube: Draw Christmas Tree on Access Report (7:36)

VBA

Standard module

'*************** Code Start ***************************************************
' Purpose  : draw a Christmas Tree on an Access report
'             specify center top coordinate and height
'             optionally set colors
'           USES Circle, Line, and Print
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Draw_ChristmasTree.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_ChristmasTree_s4p
'------------------------------------------------------------------------------
'           Global variables
'------------------------------------------------------------------------------
'comment if defined elsewhere
Public Const PI As Double = 3.14159 

Public Const gColorGreenTree As Long = 6584420  'RGB(100, 120, 100)
Public Const gColorBrown As Long = 25750  'RGB(150, 100, 0
Public Const gColorOrange As Long = 38650  'RGB(250, 150, 0)
'------------------------------------------------------------------------------
'           Draw_ChristmasTree_s4p
' send report object, top center coordinate and height
'------------------------------------------------------------------------------
Public Sub Draw_ChristmasTree_s4p(poReport As Report _ 
      ,pXCenter As Single _ 
      ,pYTop As Single _ 
      ,pYHeight As Single _ 
   ,Optional pnColorTree As Variant = gColorGreenTree _ 
   ,Optional pnColorStar As Variant = vbYellow _ 
   ,Optional pnColorStarOutline As Variant = gColorOrange _ 
   ) 
'221225 s4p
'Draw a ChristmasTree
'   measurements in twips

   On Error GoTo Proc_Err 
   'PARAMETERs
   '  poReport is the Report object
   '  pXCenter is x-coordinate of Christmas Tree center
   '  pYTop is y-coordinate of Christmas Tree top
   '  pYHeight is ChristmasTree height
   
   '(Optional) -- long integer color value
   '     defined as Variant to allow null
   '  pnColorTree
   
   If IsNull(pnColorTree) Then pnColorTree = gColorGreenTree 
   If IsNull(pnColorStar) Then pnColorStar = vbYellow 
   If IsNull(pnColorStarOutline) Then pnColorStarOutline = gColorOrange 

   'variables
   Dim X As Single,Y As Single _ 
      ,x1 As Single,y1 As Single _ 
      ,x2 As Single,y2 As Single _ 
      ,sText As String 
      
   Dim sgRadiusTree As Single _ 
      ,sgAngleTree1 As Single _ 
      ,sgAngleTree2 As Single 

   '----------------------------- customize as desired
   sgRadiusTree = pYHeight * 0.75 
         
   sgAngleTree1 = PI * 1.35 
   sgAngleTree2 = PI * 1.65 
   '-----------------------------

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

      .FillStyle = 0  'Opaque
      
      'tree stump
      x1 = pXCenter - (sgRadiusTree * 0.1) 
      x2 = pXCenter + (sgRadiusTree * 0.1) 
      
      y1 = Y + sgRadiusTree  'tree bottom
      y2 = Y + pYHeight * 0.9 
      
      .FillColor = gColorBrown 
      poReport.Line (x1,y1)-(x2,y2) _ 
         ,gColorBrown,BF 
      
      'Tree
      Y = pYTop + (pYHeight * 0.1)  'tree top
            
      .FillColor = pnColorTree 
      poReport.Circle (pXCenter,Y),sgRadiusTree _ 
         ,pnColorTree,-sgAngleTree1,-sgAngleTree2 

      'star on top
      .FontName =  "Wingdings 2"
      sText =  "ë"
      
      'outline star
      .FontSize = sgRadiusTree / 75 
      .ForeColor = pnColorStarOutline 
      .CurrentY = Y - .TextHeight(sText) / 2 
      .CurrentX = pXCenter - .TextWidth(sText) / 2 
      .Print sText 

      'star inside
      .FontSize = sgRadiusTree / 120 
      .ForeColor = pnColorStar 
      .CurrentY = Y - .TextHeight(sText) / 2 
      .CurrentX = pXCenter - .TextWidth(sText) / 2 
      .Print sText 
      
   End With 
      
Proc_Exit: 
   On Error GoTo 0 
   Exit Sub 
  
Proc_Err: 
   MsgBox Err.Description _ 
       ,, "ERROR " & Err.Number _ 
        &  "   Draw_ChristmasTree_s4p"

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

Goto Top  

rpt_Christmas Tree_Page

Code behind report to draw a default Christmas Tree on a page.

'*************** Code Start CBR ***********************************************
' Purpose  : code behind rpt_ChristmasTrees_Page
'            calls Draw_ChristmasTree_s4p
'              draw a Christmas Tree on a page
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Draw_ChristmasTrees.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 Christmas Tree on the page
   'CALLs
   '  Draw_ChristmasTree_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 
      
      'x center
      X = .ScaleLeft + dx / 2 
      'y top
      Y = .ScaleTop 
   
   End With 
   
   'Call Draw_ChristmasTree_s4p
   Call Draw_ChristmasTree_s4p(Me,X,Y,dy) 
      
End Sub 
'*************** Code End *****************************************************

Reference

Drawing Reference on MsAccessGurus

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

Circle method

Line method

Print method

TextHeight method

TextWidth method

DrawWidth property

FillColor property

FillStyle property

FontName property

FontSize property

ForeColor property

CurrentX property

CurrentY property

Sine function

Cosine function

Backstory

Merry Christmas! Best wishes to you and your loved ones. So this year is a tree with a star on top. Maybe next year, we can decorate it more (smile).

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

Share with others

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