VBA code for Moonrise/Moonset calculation

[kd4dna]

Hi, I have been searching around various astronomical websites as well as here without much luck. I'm looking to see if any one has written VBA code to perform moonrise and moonset calculations in excel given the latitude, longitude, and current date for a given location. I have found one that runs sunrise/sunset as well as twilight times, but nothing for the moon times. I ran across some old basic code that I will rewrite (if I have to) but though I'd put out feelers here to see if anyone else has done it already.

Thanks,

Ron,
kd4dna@charter.net

 

[HarryS]

the NOAA at
ESRL Global Monitoring Division - GRAD Group

''' http://www.esrl.noaa.gov/gmd/grad/solcalc/calcdetails.html

Classes can raise events ( good back to UserForm )
Using Property Let can set a new value and do the defined necessary calculations when it is changed.




sorry about the earlier mess of

 

[ZVI]

The use of 'XX(' is to replace the function with one of the same name but not to eliminate it if the NEW version is worse

Harry, I just meant that code of those functions with XX in names have to be corrected (if it's not just for debug) like this:

Function DegSinxx(x As Double) As Double
 
  ' The line below was not correct
  'DegSin = Sin(rads * x)
  
  ' Here is the corrected one
  DegSinxx = Sin(rads * x)
 
  ' Please update old name of this function in all calling from the other code!
 
End Function

As to the Class module's features - all it has sense, thank you!

 

[HarryS]

Now here is a cute trick to plot both altitude and azimuth against time

I had looked at putting a small shape at the label in the direction
Or at adding a small bitmap line to show the direction

Sorry it is Sun Only in a calculating worksheet

but I will eventually get Sun and moon as decent class modules working with memory bit maps stretchbit to a userform HDC

Option Explicit
'On another sheet  "CalcPlot"


Private Sub CommandButton21_Click()
    [c5] = Timer
    Application.ScreenUpdating = False
    CalcG
    OutITT
    Application.ScreenUpdating = True
    [d5] = Timer - [c5]
End Sub
Sub OutITT()
' makes data labels if XY scatter Graph better to read


    Dim v#, ri%, Rot%, DR#
    Rot = 10: DR = 1.2
    For ri = 11 To 29
        Rot = Rot + 1  ' back to point
        Cells(Rot, 10) = Cells(ri, 6)
        Cells(Rot, 11) = Cells(ri, 7)
        Cells(Rot, 12) = Cells(ri, 6)
        Cells(Rot, 13) = Cells(ri, 7)


        v = Cells(ri, 8)
        ' back from bearing to  OX rotation
        v = 90 - v
        If v < -90 Then v = 360 + v
        v = v * 22 / 7 / 180    ' * Deg2Rad
        '
        ' Go out in the bearing  and back to dray its direction
        '
        Rot = Rot + 1   ' out in direction
        Cells(Rot, 10) = Cells(Rot - 1, 10) + DR * Cos(v)
        Cells(Rot, 11) = Cells(Rot - 1, 11) + 10 * DR * Sin(v)    ' y scale about 10* X scale
        Cells(Rot, 13) = Cells(ri, 8)


        Rot = Rot + 1  ' back to point
        Cells(Rot, 10) = Cells(Rot - 2, 10)
        Cells(Rot, 11) = Cells(Rot - 2, 11)
    Next ri
    Range("j4").Resize(67, 4).Cells.NumberFormat = "0.0"






End Sub
Sub CalcG()


    Dim LH%, Wc As Worksheet, Ti%, Rot%, rS#
    Dim sRiseA#, sSetA#, RiseTime#, SetTime#, RiseAzimuth#, SetAzimuth#




    Set Wc = Sheets("Calculations")
    '
    'NOAA solar Calculations with "D4 to end cell deleted
    'have al ook at it as it is first


    '  http://www.esrl.noaa.gov/gmd/grad/so...lcdetails.html
    '
    Wc.Cells(3, 4) = [b7]    ' set the Date [D3] to what everdate  is in B7 of this sheet
    Rot = 10  ' Row Out
    '
    'sunrise
    RiseTime = Wc.Cells(3, 25)
    Wc.Cells(6, 2) = RiseTime
    RiseAzimuth = Wc.Cells(3, 34)
    sRiseA = Wc.Cells(3, 33)
    RiseAzimuth = Wc.Cells(3, 34)
    RiseTime = RiseTime * 24
    '
    'sunset
    SetTime = Wc.Cells(3, 26)
    Wc.Cells(6, 2) = SetTime
    sSetA = Wc.Cells(3, 33)
    SetAzimuth = Wc.Cells(3, 34)
    SetTime = SetTime * 24    '


    For Ti = 4 To 20
        rS = Ti
        If Ti > RiseTime And RiseTime <> 0 Then    ' put in rise
            Rot = Rot + 1
            Cells(Rot, 6) = RiseTime
            Cells(Rot, 7) = sRiseA
            Cells(Rot, 8) = RiseAzimuth
            RiseTime = 0    '  stop redo
        End If
        If Ti > SetTime And SetTime <> 0 Then    ' put in set
            Rot = Rot + 1
            Cells(Rot, 6) = SetTime
            Cells(Rot, 7) = sSetA
            Cells(Rot, 8) = SetAzimuth
            SetTime = 0  ' stop repeat
        End If


        Rot = Rot + 1
        Wc.Cells(6, 2) = rS / 24    ' time
        Cells(Rot, 6) = rS
        Cells(Rot, 7) = Wc.Cells(3, 33)
        Cells(Rot, 8) = Wc.Cells(3, 34)
    Next Ti
End Sub
Sub Labelit()
    Dim ri, SS$
    ActiveSheet.ChartObjects("Chart 2").Activate
    For ri = 2 To 56 Step 3
        ActiveChart.SeriesCollection(1).Points(ri).DataLabel.Select
        SS = "='CalcPlot'!R" & ri + 10 & "C13"
        Selection.Formula = SS
    Next ri
End Sub


Private Sub CommandButton22_Click()
    Labelit
End Sub

Should be worth a look ot the idea of showings bearings as an extra to a 2 D plot ( not mine but I have had some inventive students )