VideoPhoto

Showing posts with label VBA. Show all posts
Showing posts with label VBA. Show all posts

29 July, 2023

Shapes Based On Equations: Cardioids

Cardioid curve is formed by tracing a point selected on the circumference of a circle, rolling onto another circle of the same radius. Here are two examples of cardioid graphics, one is just a single cardioid curve and the other is presentation of 4 cardioids positioned within the same coordinates.

These kind of graphics can be generated using the VBA macro listed below the two charts.

28 July, 2023

Shapes Based On Parametric Equations: Epitrochoids

Epitrochoids are curves generated by a point selected on a circle of smaller radius rolling around the outside of a fixed circle of larger radius, and that selected point can be chosen at some distance from the center of the smaller circle. These are then 3-parametric curves. They can be helpful in creating decorative designs and other art applications, and can serve also as pastime and recreation for children. Since 1965 there is available a toy (geometric drawing device) known as spirograph, combining mathematics and art. It allows producing physically numerous curve designs based exactly on epitrochoid and hypotrochoid parametric equations.

However, nowadays the epitrochoids (as well as hypotrochoids - see another post at https://draft.blogger.com/blog/post/edit/3323809043368251287/9189797010242374274?hl=en-GB) can be generated quite easily in Excel by using VBA macro like the one provided at the end of this post.

Here are some examples of charts showing epitrochoid curves generated with the macro. Some of them present combined double curves.

25 July, 2023

Shapes Based On Parametric Equations: Epicycloids

Epicycloid is a parametric geometric curve obtained by tracing the path of a chosen point on the circumference of a circle (outside of it). Variety of epicycloid curves find applications in mechanical and construction engineering, e.g. construction of gears, cams, valves, pendulum clocks, robotic actuators, and machine/structures design in general. Contribute also to making designs of arts and animations.

In this context, it is useful to know how to generate epicycloid curves. In this post I'm presenting some of the curves along with the Excel VBA macro for creating this kind of curves. You can try to use it for your own creations. Just copy it to one of the modules in your workbook sheets and experiment with different settings and parameters.

Here are some examples of charts with epicycloid curves, single and double plots. 

12 July, 2023

Prime Numbers: How to Find the Highest Prime Number Below Given Limit

If you need to find/generate the highest prime number not exceeding some given limit, like e.g. 100,000, using the following Excel VBA macro is the appropriate and easy to use tool; obviously, within the Excel program specifications.

Just copy and paste the code into one of the modules of your workbook. Some explanatory notes are included within the macro.

Sub CalcTopPrimeNumberBelowGivenLimit()
'Max prime <1,000,000: 999,983
'Max prime <10,000,000: 9,999,991
'Max prime <100,000,000: 99,999,989
'Max prime <1,000,000,000: 999,999,937
'For max. integer handled by my computer (=1,068,699,999) the highest prime is: 1,068,699,979
    Dim n As Long
    Dim primes() As Boolean
    Dim i As Long, j As Long
    Dim tPrime As Long
    'Set the maximum limit for prime number generation
    n = InputBox("Enter your max. limit for the prime generation:", "Set the max. limit", 199999999)
    'Initialize the array to assume all numbers are prime
    ReDim primes(2 To n)
    For i = 2 To n
        primes(i) = True
    Next i
    'Apply the Sieve of Eratosthenes algorithm (it finds all primes up to a given limit)
    For i = 2 To Sqr(n)
        If primes(i) Then
            For j = i ^ 2 To n Step i
                primes(j) = False
            Next j
        End If
    Next i
    'Find the highest prime number
    For i = n To 2 Step -1
        If primes(i) Then
            tPrime = i
            Exit For
        End If
    Next i
    'Display the result
    MsgBox "The highest prime number below " & n & " is " & tPrime
End Sub 

 

08 June, 2023

Marching Squares Image

Created with Excel VBA (example):

If you have generated similar images in Excel, can you share them with me...😄

 



03 April, 2022

Workbook Events: Printing - Speach - Alerts

When printing in Excel, one quite frequently makes mistakes. Sometimes the printout does not look as expected and we may waste more paper than necessary. To reduce such outcomes to minimum we can utilize Excel event feature called BeforePrint.

You can use the following workbook event procedure (VBA code) that will - just before printing your worksheet/selection - alert you with speech feature by asking if you are sure that your workbook and the print settings are OK; if not, printing is cancelled.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
 For Each wk In Worksheets  'Make sure that worksheets are recalculated before printing
    wk.Calculate
 Next
 vbOption = MsgBox("Are you sure that all settings are OK and print can be started?", vbYesNo)
 If vbOption = 7 Then  
'6=Yes, 7=No
    Cancel = True
    Application.Speech.Speak "Print is cancelled."
'    MsgBox ("Print is cancelled.") 'optional
    Else
        Application.Speech.Speak "Recalculation is completed and now printing takes place."
    End If

End Sub

To implement this procedure, select the Developer tab in the ribbon and select Visual Basic from the menu, then select the View tab>Project Explorer. In VBAProject of your workbook click on ThisWorkbook, then copy the code provided here and paste it into the space located directly under the Workbook field there. Save your workbook as Excel Macro-Enabled Workbook.

Try to print something to see if the event procedure works as intended.

 

23 January, 2022

Creating Pixel Art - Iterations

You can use Excel to create some work of art. Over 32000 iterations can be utilized, and this allows to produce lots of pixels in your worksheet and, practically, create unlimited number of 2D 'pictures' and 3D 'sculptures'. All you need is to use the two macros presented at the end of this post (one for drawing and the other for erasing) and some creativity, obviously.

To give you an idea what kind of 'art' I'm talking about, here are just couple of examples:

 

 


Before starting your creative work you need to determine name for your picture. Go to Formulas > Define Name in your workbook and enter TRI in the Name: field and =Sheet1!$B$2:$ZZ$601 in Refers to: field.

Next, insert and format two Buttons (Form Controls) similar to what you see here:

Goto to Developer > Insert > Button, add the text (Draw..., Erase...) and assign the two macros to them. You'll use the buttons to create and erase the pictures.

Now you can copy the macros listed below to one of the modules inserted in your workbook (VBAProject). At this point you're ready to start experimenting with the pixel art. There are several parameters (variables) plus functions, formulas, equations, colors etc. that can be changed and manipulated at will.

Here are the macros:

Option Explicit
Sub Sculpture()
'Produces graphics: from random mist to well defined pixel art
'Use provided parameters and translations to define "sculptures"
'Takes several seconds to produce some pixel art

Dim cP(3) As Long
Dim wid As Double
Dim myPts As Single
Dim myRange As Range
Dim cx As Double, cy As Double, rC As Double, iC As Double
Dim xUL As Double, xLL As Double, yUL As Double, yLL As Double
Dim y As Double, x As Double, c As Double, d As Double
Dim intW As Integer, intH As Integer, i As Integer, j As Integer
Dim a As Single, b As Single, sPercent As Single, co As Single
'Color palette; change as needed
cP(0) = 65280       'green
cP(1) = 65535       'yellow
cP(2) = 13382400    'blue
cP(3) = 255         'red
On Error GoTo TheEnd
'Set your canvas range for square cells; here set to B2:ZZ601
Set myRange = Application.InputBox("Select a range in which to create square cells", ,  _"$B$2:$ZZ$601", Type:=8)
On Error Resume Next
If myRange.Cells.Count = 0 Then Exit Sub
GetWidth:       'Set the width of cells (0.08 is my screen pixel size)
wid = Val(InputBox("Input Column Width:", , "0.08"))
If wid < 0.08 Then
    MsgBox "Invalid column width value"
    GoTo GetWidth
End If
Application.ScreenUpdating = False
myRange.EntireColumn.ColumnWidth = wid
myPts = myRange(1).Width        'Set row height
myRange.EntireRow.RowHeight = myPts
xLL = -1.02: xUL = 3.02: yLL = -1.02: yUL = 2.59
intW = myRange.Columns.Count: intH = myRange.Rows.Count
Application.Goto reference:="TRI"   'TRI is the named range (=Sheet1!$B$2:$ZZ$601")
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 0   'Background color; set to black
End With
Range("A1").Select
x = 0: y = 0
cx = 1: cy = 0.5
a = Rnd() * (-10 - 10) + 10: b = Rnd() * (-10 - 10) + 10  'Random real numbers between -10 & 10
For j = 1 To 4      'Iterate by colors
    Select Case j
        Case 1
            co = cP(0)
        Case 2
            co = cP(1)
        Case 3
            co = cP(2)
        Case Else
            co = cP(3)
    End Select
    For i = 1 To 30000  'Number of iterations with each of the colors
        x = cx: y = cy
        c = Sin(a * x): d = Cos(b * y ^ 2)  'Use any other formulas to get desirable results
        cx = d + c * c + 0.6: cy = Sin(2 * a * x) - Sin(c) * d + 0.8    'As above
        iC = Int(intW * (cx - xLL) / (xUL - xLL)): rC = Int(intH * (cy - yLL) / (yUL - yLL))
        myRange.Cells(1 + rC, 1 + iC).Interior.Color = co
        If iC < 2 Then iC = 2: If iC > intW Then iC = intW
        If rC < 2 Then rC = 2: If rC > intH Then rC = intH
    Next i
Next j
Range("Sheet1!B1").Select
myRange.Cells(1, 1).Offset(-1, 0) = "Basic parameters used: a=" & Format(a, "#0.0;-#0.0") & ", b=" & _Format(b, "#0.0;-#0.0")
Application.ScreenUpdating = True
myRange.Cells(1, 1).Offset(-1, -1).Select
TheEnd:
Set myRange = Nothing
If Application.ScreenUpdating = False Then Application.ScreenUpdating = True
End Sub
 

Sub EraseSculpt()
'Clear the graphic and restore cell size
Dim TRI As Name
Application.ScreenUpdating = False
    Application.Goto reference:="TRI"
    Selection.Clear
    With Selection
        .ColumnWidth = 8.43
        .RowHeight = 12.75
    End With
    Range("B1").Select
    Selection.ClearContents
    Range("A2").Select
Application.ScreenUpdating = True
End Sub

 

12 June, 2021

Font color change within cell formula

Formulas in Excel usually don't care about the font color in displaying their results in a cell. However, you may need sometimes to distinguish between some results of your calculations by using specific font colors.

It is possible to assign a specific font color to a cell value, without any conditional formatting.

E.g., let's say, you want to compare two numbers (located in cells A1 and B1) and assign font color to the result of the formula like this one: =IF(A1>B1,22,33).  Depending on the outcome of comparison, if A1>B1 then you want to display 22 in green color; otherwise you want to display 33 in red.

To do that with a formula, you need to amend the formula with this kind of UDF (user defined function): 

 Function CFcolor(num1 As Double, num2 As Double) As Boolean
    If num1 <= num2 Then
        Application.Caller.Font.ColorIndex = 3       'red
    Else
        Application.Caller.Font.ColorIndex = 10     'green
    End If
End Function 

so that your formula looks like this:  =IF(A1>B1,22,33)+CFcolor(A1,B1) .

Obviously, to make use of the function, you have to copy and paste it first into a Module of your VBAProject (your workbook) or of your Personal workbook.

The function can be quite easily modified for use with other Excel formulas and colors.

 

08 June, 2021

How to create a 'slide show' using a single formula and a chart

If you want to make use of some math formulas for practical applications or just to show off your Excel creativity, you can utilize kind of slide show: = refreshable charts based on your brilliant formula.

Follow these steps:

  • Open a new workbook. Enter any two numbers into your worksheet (Sheet1), e.g. 1 in cell A2 and 2 in B2.
  • Start with creating a simple XY scatter chart based on your entries. This chart is named as "Chart 1".
  • Delete the two numbers you've just entered. You don't need them.
  • Expand the width of column A to e.g. 200, move there the chart and resize it to the size of your choice.
  • In cell D1, type the formula you want to chart, in the format using explicitly normal math signs and functions, e.g. x^2+5*sqrt(x)-3 .
  • Enter the low and high limits (of your choice) for the Left value and the Right value of x axis, then also the Low and High limits for the number of Points you want to be plotted, as shown in the example below (cells D3:E5).
  • In cells F3:F5, enter RANDBETWEEN formulas as shown in the example, cells F3:F5.

28 May, 2021

Pie chart: wheel of VBA colors

If you use Excel VBA and need to set color or get color for cell, shape or chart, you may need the VBA color code list for reference purposes. The ColorIndex offers 56 basic colors and it's hard to remember VB codes for all of them. The following chart can be helpful, if you don't know the color code for your specific task:

In case you'd need to recreate the chart on your own computer,

11 May, 2021

World of Fractals - Beauty of Recursion

In my computer programming adventures I tried many things.  Among them I've explored  iteration and recursion.

Iteration is simpler, because it's basically just a For loop used in all common languages. It handles a number of steps consecutively.  You go up or down, step by step, until you reach the top or the bottom.

Recursion is much more convoluted.  It's a way of thinking and solving problems, because there is more then iteration to it.  Steps are also repeated here, but you reduce the problem to a smaller tasks and handle them separately;  sort of divide-and-conquer strategy involving inheritance.  You define the value of your function, which has more than one variable, by using other values of the same function, i.e. you change only one variable and keep all others constant, until some endpoint is reached, and then change something else, reach another endpoint, and so forth.

Recursive algorithms take many forms.  It's the beauty of math, really, which shows up in many of those algorithms.  One example of recursion is fractals.  The whole art of fractals evolved in recent years.  Have a look at its beauty e.g. at this website.

I've just touched the recursion issue many years ago.  Sometimes it took several hours of my computer time to produce a complex picture, but it was quite satisfying to see the algorithm at work.

Here are some examples of what I was able to create in early 1990s.