|
|
|
You can use these fun snowflakes for holiday letters and to make your reports more festive. VBA procedure that's easy to call from code behind your Access reports.
Send the center coordinate and size. Optionally, you can also choose colors and start angle.
The code that does the drawing is all in one module you can import into your projects. It uses Circle and Line methods.
Download zipped BAS file you can import into your Access projects: bas_Draw_Snowflake_s4p.zip
Download zipped ACCDB file with sample data, a module, and 3 sample reports: Draw_Snowflake_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
'*************** Code Start *************************************************** ' Purpose : draw a Snowflake on an Access report ' specify center coordinate and radius ' optionally set snowflake and background colors ' USES Circle and Line ' Author : crystal (strive4peace) ' Code List: www.msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/Draw_Snowflakes.htm ' LICENSE : ' You may freely use and share this code, but not sell it. ' Keep attribution. Mark your changes. Use at your own risk. '------------------------------------------------------------------------------ ' Global variables '------------------------------------------------------------------------------ Public Const PI As Double = 3.14159 Public Const gColorCyan As Long = 16769385 'RGB(105, 225, 255) '------------------------------------------------------------------------------ ' Draw_Snowflake_s4p ' send center coordinate and size '------------------------------------------------------------------------------ Public Sub Draw_Snowflake_s4p(poReport As Report _ ,pXCenter As Single _ ,pYCenter As Single _ ,ByVal pRadius As Single _ ,Optional pnColor1 As Long = gColorCyan _ ,Optional pnColor2 As Long = 0 _ ,Optional psgAngleStart As Single = 0 _ ) '221216 s4p 'Draw a Snowflake ' measurements in twips On Error GoTo Proc_Err 'PARAMETERs ' poReport is the Report object ' pXCenter is x-coordinate of snowflake center ' pYCenter is y-coordinate of snowflake center ' pRadius is snowflake radius '(Optional) ' pnColor1 = snowflake color ' Default is cyan ' pnColor2 = background color ' negative number is NO Background ' default is black circle background 'X and Y are for Line coordinates 'sgAngle is to calculate X and Y Dim X As Single,Y As Single _ ,x1 As Single,y1 As Single _ ,x2 As Single,y2 As Single _ ,sgAngle As Single _ ,sgAngleLeft As Single _ ,sgAngleRight As Single _ ,sgRadius1 As Single _ ,sgRadius2 As Single _ ,sgLength1 As Single _ ,sgLength2 As Single _ ,i As Integer 'adjust radius to account for draw width pRadius = pRadius * 0.93 '----------------------------- customize as desired sgRadius1 = pRadius / 3 sgRadius2 = 2 * pRadius / 3 sgLength1 = pRadius / 3 sgLength2 = pRadius / 3 sgAngleLeft = PI / 3 sgAngleRight = -PI / 3 '----------------------------- With poReport .ScaleMode = 1 'twips .DrawWidth = pRadius / 50 'relative based on size .FillStyle = 0 'Opaque If pnColor2 >= 0 Then 'draw circle background .FillColor = pnColor2 poReport.Circle (pXCenter,pYCenter) _ ,pRadius _ ,pnColor2 End If 'draw needles sgAngle = psgAngleStart '6 sides For i = 0 To 5 X = pXCenter + Cos(sgAngle) * pRadius Y = pYCenter + Sin(sgAngle) * pRadius 'big needle .DrawWidth = pRadius / 50 poReport.Line (pXCenter,pYCenter)-(X,Y) _ ,pnColor1 'inner little needles. x1, y1 same for both lines x1 = pXCenter + Cos(sgAngle) * sgRadius1 y1 = pYCenter + Sin(sgAngle) * sgRadius1 'left needle x2 = x1 + Cos(sgAngle + sgAngleLeft) * sgLength1 y2 = y1 + Sin(sgAngle + sgAngleLeft) * sgLength1 .DrawWidth = pRadius / 150 poReport.Line (x1,y1)-(x2,y2),pnColor1 'right needle x2 = x1 + Cos(sgAngle + sgAngleRight) * sgLength1 y2 = y1 + Sin(sgAngle + sgAngleRight) * sgLength1 poReport.Line (x1,y1)-(x2,y2),pnColor1 'outer needles x1 = pXCenter + Cos(sgAngle) * sgRadius2 y1 = pYCenter + Sin(sgAngle) * sgRadius2 x2 = x1 + Cos(sgAngle + sgAngleLeft) * sgLength2 y2 = y1 + Sin(sgAngle + sgAngleLeft) * sgLength2 .DrawWidth = pRadius / 100 poReport.Line (x1,y1)-(x2,y2),pnColor1 x2 = x1 + Cos(sgAngle + sgAngleRight) * sgLength2 y2 = y1 + Sin(sgAngle + sgAngleRight) * sgLength2 poReport.Line (x1,y1)-(x2,y2),pnColor1 'next angle sgAngle = sgAngle - 2 * PI / 6 Next i End With Proc_Exit: On Error GoTo 0 Exit Sub Proc_Err: MsgBox Err.Description _ ,, "ERROR " & Err.Number _ & " Draw_Snowflake_s4p" Resume Proc_Exit Resume End Sub '*************** Code End *****************************************************
Code behind report to draw Snowflakes based on status colors.
'*************** Code Start Report1 *********************************************** ' Purpose : code behind rpt_Snowflakes_Colors ' calls Draw_Snowflake_s4p ' to draw Snowflakes based on status colors ' Author : crystal (strive4peace) ' Code List: www.msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/Draw_Snowflakes.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 Snowflakes in the detail section of a report based on status colors 'CALLs ' Draw_Snowflake_s4p Dim X As Single,Y As Single _ ,sgRadius As Single 'left X = 0.5 * 1440 'top Y = 0.5 * 1440 'radius sgRadius = 0.5 * 1440 With Me 'Call Draw_Snowflake_s4p Call Draw_Snowflake_s4p(Me,X,Y,sgRadius _ ,Nz(.Colr1,0),Nz(.Colr2,-99)) End With End Sub '*************** Code End *****************************************************
Let it snow! Random snowflakes all over the page
'*************** Code Start Report2 *********************************************** ' Purpose : code behind rpt_Snowflakes_Page ' calls Draw_Snowflake_s4p ' draw random Snowflakes all over the page ' different sizes and start angles ' Author : crystal (strive4peace) ' Code List: www.msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/Draw_Snowflakes.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 random Snowflakes all over the page 'CALLs ' Draw_Snowflake_s4p Dim X As Single,Y As Single _ ,x1 As Single,y1 As Single _ ,dx As Single,dy As Single _ ,sgAngle As Single _ ,sgRadius1 As Single _ ,sgRadius2 As Single _ ,sgRadius As Single _ ,iNumber As Integer _ ,iNumberSizes As Integer _ ,i As Integer _ ,j As Integer '---------------- customize Const NUMBERofSNOWFLAKES As Integer = 64 sgRadius1 = 360 sgRadius2 = 800 iNumberSizes = 4 '---------------- With Me .ScaleMode = 1 'twips 'width and height for drawing dx = .ScaleWidth dy = .ScaleHeight - .PageFooterSection.Height 'left X = .ScaleLeft 'top Y = .ScaleTop End With Randomize For i = 1 To iNumberSizes If i = 1 Then sgRadius = sgRadius1 ElseIf i = iNumberSizes Then sgRadius = sgRadius2 Else sgRadius = sgRadius1 + _ (sgRadius2 - sgRadius1) / (iNumberSizes - 2) * (i - 1) End If For j = 1 To NUMBERofSNOWFLAKES \ iNumberSizes 'get random coordinate x1 = (dx + 1) * Rnd + X y1 = (dy + 1) * Rnd + Y 'random start angle sgAngle = (2 * PI) * Rnd 'Call Draw_Snowflake_s4p -99 = no background Call Draw_Snowflake_s4p(Me,x1,y1,sgRadius _ ,,-99,sgAngle) Next j Next i End Sub '*************** Code End *****************************************************
Code behind report to draw specified number of snowflakes on a row in the detail section. Make them as big as possible.
'*************** Code Start Report3 *********************************************** ' Purpose : code behind rpt_Snowflakes_Detail_Numberz ' calls Draw_Snowflake_s4p ' draw specified number of snowflakes ' in the Detail section ' Author : crystal (strive4peace) ' Code List: www.msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/Draw_Snowflakes.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 Snowflakes in the detail section of a report 'CALLs ' Draw_Snowflake_s4p 'USES ' global variables defined in bas_Draw_Snowflake_s4p ' gap between snowflake and edge Const sgPERCENTsize As Single = 0.9 Dim X As Single,Y As Single _ ,x1 As Single,y1 As Single _ ,dx As Single,dy As Single _ ,xMaxWidth As Single _ ,sgRadius As Single _ ,iNumber As Integer _ ,i As Integer With Me 'number of snowflakes to draw, bound to Numberz iNumber = .Num .ScaleMode = 1 'twips 'width and height for drawing dx = .ScaleWidth * sgPERCENTsize dy = .ScaleHeight * sgPERCENTsize 'left X = .ScaleLeft + (.ScaleWidth - dx) / 2 '+margin 'top Y = .ScaleTop + (.ScaleHeight - dy) / 2 'maximum width of each snowflake xMaxWidth = dx / iNumber 'which is less -- X or Y? If xMaxWidth > dy Then sgRadius = dy / 2 Else sgRadius = xMaxWidth / 2 End If End With y1 = Y + sgRadius 'put extra space below 'loop and Call Draw_Snowflake_s4p For i = 1 To iNumber x1 = X + xMaxWidth * (i - 0.5) Call Draw_Snowflake_s4p(Me,x1,y1,sgRadius) Next i End Sub '*************** Code End *****************************************************' Code was generated with colors using the free Color Code add-in for Access.
Report Draw Reference for VBA syntax and help for drawing on Access reports.
Christmas is coming and I think of snow! Drawing is fun, and everybody loves visualizations. I hope you enjoy putting Snowflakes on your Access reports.
If you like this page, please let me know, thank you. Donations are much appreciated
Here's the link for this page in case you want to copy it and share it with someone:
https://msaccessgurus.com/VBA/Draw_Snowflakes.htm
or in old browsers:
http://www.msaccessgurus.com/VBA/Draw_Snowflakes.htm
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
~ crystal
the simplest way is best, but usually the hardest to see