אופיס 365 זמני היום בVisual Basic

  • הוסף לסימניות
  • #1
  • הוסף לסימניות
  • #2
ברפרוף מלמעלה, נראה שאפשר בקלות להתאים את ה-VB באקסל לאקסס
יש שם כמה פונקציות (קבועות) שצריך להתאים.
 
  • הוסף לסימניות
  • #3
יש פרויקט שנכתב בJAVA ע"י אליהו הרשפלד לחישוב זמני היום, הומר לדוטנט ע"י יצחק, והותאם לVBA ע"י. יש 122 זמנים המחושבים ע"י הפרויקט הנ"ל. אם תרצה אוכל להעלות את קבצי הDLL ו/או את קוד המקור.


עשיתי את השינויים הנדרשים בקוד מהקובץ שציינת (כמדומה שהעליתי אותו כאן בעבר) כדי להתאימו לאקסס.

ראשית הדגמה קצרה כיצד להשתמש בו בדוגמאות אלו אני משתמש עם הקיארדונציות של ירושלים):
זמן טלית ותפילין (לשיטות שהוא מחושב כאשר השמש נמצאת 11.5 מעלות מתחת קו האופק)
קוד:
Format(Dawn(31.771959,35.217018,2017,02,15,2,0,11.5),"HH:MM:SS AMPM")
לילה לר"ת (לשיטות שהוא מחושב כאשר השמש נמצאת 16.1 מעלות מתחת קו האופק)
קוד:
Format(Dusk(31.771959,35.217018,2017,02,15,2,0,16.1),"HH:MM:SS AMPM")
תשוה את התוצאות עם התוצאות מאתר זה: https://www.myzmanim.com

שים לב שניתן לחשב זמנים רבים באמצעות השימוש בשתי פונקציות אלו, רק צריך לשנות את הארגומנט האחרון למספר המעלות מתחת לאופק. עם הפונקציה Dawn יש להשתמש לחישובי יום כאשר השמש מתחת האופק המזרחי, ובפונקציה Dusk יש להשתמש לחישובי לילה כאשר השמש מתחת האופק המערבי. לחישובים כאשר השמש נמצאת מעל האופק, אורך שעה זמנית וכדו' יש צורך בחישובים נוספים.

ועכשיו לקוד עצמו:
קוד:
' Calculation of local times of sunrise, solar noon, and sunset
' based on the calculation procedure by NOAA in the javascript in
' http://www.srrb.noaa.gov/highlights/sunrise/sunrise.html and
' http://www.srrb.noaa.gov/highlights/sunrise/azel.html
'
' Five functions are available for use from Excel worksheets:
'
'   - sunrise(lat, lon, year, month, day, timezone, dlstime)
'   - solarnoon(lat, lon, year, month, day, timezone, dlstime)
'   - sunset(lat, lon, year, month, day, timezone, dlstime)
'   - solarazimuth(lat, lon, year, month, day, hour, minute, second, timezone, dlstime)
'   - solarelevation(lat, lon, year, month, day, hour, minute, second, timezone, dlstime)
'
' The sign convention for inputs to the functions named sunrise, solarnoon,
' sunset, solarazimuth, and solarelevationis:
'
'   - positive latitude decimal degrees for northern hemisphere
'   - negative longitude degrees for western hemisphere
'   - negative time zone hours for western hemisphere
'
' The other functions in the VBA module use the original
' NOAA sign convention of positive longitude in the western hemisphere.
'
' The calculations in the NOAA Sunrise/Sunset and Solar Position
' Calculators are based on equations from Astronomical Algorithms,
' by Jean Meeus. NOAA also included atmospheric refraction effects.
' The sunrise and sunset results were reported by NOAA
' to be accurate to within +/- 1 minute for locations between +/- 72°
' latitude, and within ten minutes outside of those latitudes.
'
' This translation was tested for selected locations
' and found to provide results within +/- 1 minute of the
' original Javascript code.
'
' This translation does not include calculation of prior or next
' susets for locations above the Arctic Circle and below the
' Antarctic Circle, when a sunrise or sunset does not occur.
'
' Translated from NOAA's Javascript to Excel VBA by:
'
' Greg Pelletier
' Department of Ecology
' P.O.Box 47600
' Olympia, WA 98504-7600
' email: gpel461@ ecy.wa.gov


Option Explicit

Function radToDeg(angleRad)
    '// Convert radian angle to degrees
    radToDeg = (180# * angleRad / Pi)
End Function

Function degToRad(angleDeg)
    '// Convert degree angle to radians
    degToRad = (Pi * angleDeg / 180#)
End Function

Function calcJD(year, month, day)
    
    '***********************************************************************/
    '* Name:    calcJD
    '* Type:    Function
    '* Purpose: Julian day from calendar day
    '* Arguments:
    '*   year : 4 digit year
    '*   month: January = 1
    '*   day  : 1 - 31
    '* Return value:
    '*   The Julian day corresponding to the date
    '* Note:
    '*   Number is returned for start of day.  Fractional days should be
    '*   added later.
    '***********************************************************************/
    
    Dim A As Double, B As Double, JD As Double
    
    If (month <= 2) Then
        year = year - 1
        month = month + 12
    End If
    
    A = Floor(year / 100, 1)
    B = 2 - A + Floor(A / 4, 1)
    
    JD = Floor(365.25 * (year + 4716), 1) + _
        Floor(30.6001 * (month + 1), 1) + day + B - 1524.5
    calcJD = JD
    
    'gp put the year and month back where they belong
    If month = 13 Then
        month = 1
        year = year + 1
    End If
    If month = 14 Then
        month = 2
        year = year + 1
    End If
    
End Function

Function calcTimeJulianCent(JD)
    
    '***********************************************************************/
    '* Name:    calcTimeJulianCent
    '* Type:    Function
    '* Purpose: convert Julian Day to centuries since J2000.0.
    '* Arguments:
    '*   jd : the Julian Day to convert
    '* Return value:
    '*   the T value corresponding to the Julian Day
    '***********************************************************************/
    
    Dim t As Double
    
    t = (JD - 2451545#) / 36525#
    calcTimeJulianCent = t
    
End Function

Function calcJDFromJulianCent(t)
    
    '***********************************************************************/
    '* Name:    calcJDFromJulianCent
    '* Type:    Function
    '* Purpose: convert centuries since J2000.0 to Julian Day.
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   the Julian Day corresponding to the t value
    '***********************************************************************/
    
    Dim JD As Double
    
    JD = t * 36525# + 2451545#
    calcJDFromJulianCent = JD
    
End Function

Function calcGeomMeanLongSun(t)
    
    '***********************************************************************/
    '* Name:    calGeomMeanLongSun
    '* Type:    Function
    '* Purpose: calculate the Geometric Mean Longitude of the Sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   the Geometric Mean Longitude of the Sun in degrees
    '***********************************************************************/
    
    Dim l0 As Double
    
    l0 = 280.46646 + t * (36000.76983 + 0.0003032 * t)
    Do
        If (l0 <= 360) And (l0 >= 0) Then Exit Do
        If l0 > 360 Then l0 = l0 - 360
        If l0 < 0 Then l0 = l0 + 360
    Loop
    
    calcGeomMeanLongSun = l0
    
End Function

Function calcGeomMeanAnomalySun(t)
    
    '***********************************************************************/
    '* Name:    calGeomAnomalySun
    '* Type:    Function
    '* Purpose: calculate the Geometric Mean Anomaly of the Sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   the Geometric Mean Anomaly of the Sun in degrees
    '***********************************************************************/
    
    Dim m As Double
    
    m = 357.52911 + t * (35999.05029 - 0.0001537 * t)
    calcGeomMeanAnomalySun = m
    
End Function

Function calcEccentricityEarthOrbit(t)
    
    '***********************************************************************/
    '* Name:    calcEccentricityEarthOrbit
    '* Type:    Function
    '* Purpose: calculate the eccentricity of earth's orbit
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   the unitless eccentricity
    '***********************************************************************/
    
    Dim e As Double
    
    e = 0.016708634 - t * (0.000042037 + 0.0000001267 * t)
    calcEccentricityEarthOrbit = e
    
End Function

Function calcSunEqOfCenter(t)
    
    '***********************************************************************/
    '* Name:    calcSunEqOfCenter
    '* Type:    Function
    '* Purpose: calculate the equation of center for the sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   in degrees
    '***********************************************************************/
    
    Dim m As Double, mrad As Double, sinm As Double, sin2m As Double, sin3m As Double
    Dim c As Double
    
    m = calcGeomMeanAnomalySun(t)
    
    mrad = degToRad(m)
    sinm = Sin(mrad)
    sin2m = Sin(mrad + mrad)
    sin3m = Sin(mrad + mrad + mrad)
    
    c = sinm * (1.914602 - t * (0.004817 + 0.000014 * t)) _
        + sin2m * (0.019993 - 0.000101 * t) + sin3m * 0.000289
    
    calcSunEqOfCenter = c
    
End Function

Function calcSunTrueLong(t)
    
    '***********************************************************************/
    '* Name:    calcSunTrueLong
    '* Type:    Function
    '* Purpose: calculate the true longitude of the sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   sun's true longitude in degrees
    '***********************************************************************/
    
    Dim l0 As Double, c As Double, O As Double
    
    l0 = calcGeomMeanLongSun(t)
    c = calcSunEqOfCenter(t)
    
    O = l0 + c
    calcSunTrueLong = O
    
End Function

Function calcSunTrueAnomaly(t)
    
    '***********************************************************************/
    '* Name:    calcSunTrueAnomaly (not used by sunrise, solarnoon, sunset)
    '* Type:    Function
    '* Purpose: calculate the true anamoly of the sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   sun's true anamoly in degrees
    '***********************************************************************/
    
    Dim m As Double, c As Double, v As Double
    
    m = calcGeomMeanAnomalySun(t)
    c = calcSunEqOfCenter(t)
    
    v = m + c
    calcSunTrueAnomaly = v
    
End Function

Function calcSunRadVector(t)
    
    '***********************************************************************/
    '* Name:    calcSunRadVector (not used by sunrise, solarnoon, sunset)
    '* Type:    Function
    '* Purpose: calculate the distance to the sun in AU
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   sun radius vector in AUs
    '***********************************************************************/
    
    Dim v As Double, e As Double, R As Double
    
    v = calcSunTrueAnomaly(t)
    e = calcEccentricityEarthOrbit(t)
    
    R = (1.000001018 * (1 - e * e)) / (1 + e * Cos(degToRad(v)))
    calcSunRadVector = R
    
End Function

Function calcSunApparentLong(t)
    
    '***********************************************************************/
    '* Name:    calcSunApparentLong (not used by sunrise, solarnoon, sunset)
    '* Type:    Function
    '* Purpose: calculate the apparent longitude of the sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   sun's apparent longitude in degrees
    '***********************************************************************/
    
    Dim O As Double, omega As Double, lambda As Double
    
    O = calcSunTrueLong(t)
    
    omega = 125.04 - 1934.136 * t
    lambda = O - 0.00569 - 0.00478 * Sin(degToRad(omega))
    calcSunApparentLong = lambda
    
End Function

Function calcMeanObliquityOfEcliptic(t)
    
    '***********************************************************************/
    '* Name:    calcMeanObliquityOfEcliptic
    '* Type:    Function
    '* Purpose: calculate the mean obliquity of the ecliptic
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   mean obliquity in degrees
    '***********************************************************************/
    
    Dim seconds As Double, e0 As Double
    
    seconds = 21.448 - t * (46.815 + t * (0.00059 - t * (0.001813)))
    e0 = 23# + (26# + (seconds / 60#)) / 60#
    calcMeanObliquityOfEcliptic = e0
    
End Function

Function calcObliquityCorrection(t)
    
    '***********************************************************************/
    '* Name:    calcObliquityCorrection
    '* Type:    Function
    '* Purpose: calculate the corrected obliquity of the ecliptic
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   corrected obliquity in degrees
    '***********************************************************************/
    
    Dim e0 As Double, omega As Double, e As Double
    
    e0 = calcMeanObliquityOfEcliptic(t)
    
    omega = 125.04 - 1934.136 * t
    e = e0 + 0.00256 * Cos(degToRad(omega))
    calcObliquityCorrection = e
    
End Function

Function calcSunRtAscension(t)
    
    '***********************************************************************/
    '* Name:    calcSunRtAscension (not used by sunrise, solarnoon, sunset)
    '* Type:    Function
    '* Purpose: calculate the right ascension of the sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   sun's right ascension in degrees
    '***********************************************************************/
    
    Dim e As Double, lambda As Double, tananum As Double, tanadenom As Double
    Dim alpha As Double
    
    e = calcObliquityCorrection(t)
    lambda = calcSunApparentLong(t)
    
    tananum = (Cos(degToRad(e)) * Sin(degToRad(lambda)))
    tanadenom = (Cos(degToRad(lambda)))
    
    'original NOAA code using javascript Math.Atan2(y,x) convention:
    '        var alpha = radToDeg(Math.atan2(tananum, tanadenom));
    '        alpha = radToDeg(Application.WorksheetFunction.Atan2(tananum, tanadenom))
    
    'translated using Excel VBA Application.WorksheetFunction.Atan2(x,y) convention:
    alpha = radToDeg(Atan2(tanadenom, tananum))
    
    calcSunRtAscension = alpha
    
End Function

Function calcSunDeclination(t)
    
    '***********************************************************************/
    '* Name:    calcSunDeclination
    '* Type:    Function
    '* Purpose: calculate the declination of the sun
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   sun's declination in degrees
    '***********************************************************************/
    
    Dim e As Double, lambda As Double, sint As Double, theta As Double
    
    e = calcObliquityCorrection(t)
    lambda = calcSunApparentLong(t)
    
    sint = Sin(degToRad(e)) * Sin(degToRad(lambda))
    theta = radToDeg(Asin(sint))
    calcSunDeclination = theta
    
End Function

Function calcEquationOfTime(t)
    
    '***********************************************************************/
    '* Name:    calcEquationOfTime
    '* Type:    Function
    '* Purpose: calculate the difference between true solar time and mean
    '*     solar time
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '* Return value:
    '*   equation of time in minutes of time
    '***********************************************************************/
    
    Dim epsilon As Double, l0 As Double, e As Double, m As Double
    Dim Y As Double, sin2l0 As Double, sinm As Double
    Dim cos2l0 As Double, sin4l0 As Double, sin2m As Double, Etime As Double
    
    epsilon = calcObliquityCorrection(t)
    l0 = calcGeomMeanLongSun(t)
    e = calcEccentricityEarthOrbit(t)
    m = calcGeomMeanAnomalySun(t)
    
    Y = Tan(degToRad(epsilon) / 2#)
    Y = Y ^ 2
    
    sin2l0 = Sin(2# * degToRad(l0))
    sinm = Sin(degToRad(m))
    cos2l0 = Cos(2# * degToRad(l0))
    sin4l0 = Sin(4# * degToRad(l0))
    sin2m = Sin(2# * degToRad(m))
    
    Etime = Y * sin2l0 - 2# * e * sinm + 4# * e * Y * sinm * cos2l0 _
        - 0.5 * Y * Y * sin4l0 - 1.25 * e * e * sin2m
    
    calcEquationOfTime = radToDeg(Etime) * 4#
    
End Function

Function calcHourAngleDawn(lat, solarDec, solardepression)
    
    '***********************************************************************/
    '* Name:    calcHourAngleDawn
    '* Type:    Function
    '* Purpose: calculate the hour angle of the sun at dawn for the
    '*         latitude
    '*         for user selected solar depression below horizon
    '* Arguments:
    '*   lat : latitude of observer in degrees
    '*   solarDec : declination angle of sun in degrees
    '*   solardepression: angle of the sun below the horizion in degrees
    '* Return value:
    '*   hour angle of dawn in radians
    '***********************************************************************/
    
    Dim latRad As Double, sdRad As Double, HAarg As Double, HA As Double
    
    latRad = degToRad(lat)
    sdRad = degToRad(solarDec)
    
    HAarg = (Cos(degToRad(90 + solardepression)) / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad))
    
    HA = (Acos(Cos(degToRad(90 + solardepression)) _
        / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad)))
    
    calcHourAngleDawn = HA
    
End Function

Function calcHourAngleSunrise(lat, solarDec)
    
    '***********************************************************************/
    '* Name:    calcHourAngleSunrise
    '* Type:    Function
    '* Purpose: calculate the hour angle of the sun at sunrise for the
    '*         latitude
    '* Arguments:
    '*   lat : latitude of observer in degrees
    '* solarDec : declination angle of sun in degrees
    '* Return value:
    '*   hour angle of sunrise in radians
    '*
    '* Note: For sunrise and sunset calculations, we assume 0.833° of atmospheric refraction
    '* For details about refraction see http://www.srrb.noaa.gov/highlights/sunrise/calcdetails.html
    '*
    '***********************************************************************/
    
    Dim latRad As Double, sdRad As Double, HAarg As Double, HA As Double
    
    latRad = degToRad(lat)
    sdRad = degToRad(solarDec)
    
    HAarg = (Cos(degToRad(90.833)) / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad))
    
    HA = (Acos(Cos(degToRad(90.833)) _
        / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad)))
    
    calcHourAngleSunrise = HA
    
End Function

Function calcHourAngleSunset(lat, solarDec)
    
    '***********************************************************************/
    '* Name:    calcHourAngleSunset
    '* Type:    Function
    '* Purpose: calculate the hour angle of the sun at sunset for the
    '*         latitude
    '* Arguments:
    '*   lat : latitude of observer in degrees
    '* solarDec : declination angle of sun in degrees
    '* Return value:
    '*   hour angle of sunset in radians
    '*
    '* Note: For sunrise and sunset calculations, we assume 0.833° of atmospheric refraction
    '* For details about refraction see http://www.srrb.noaa.gov/highlights/sunrise/calcdetails.html
    '*
    '***********************************************************************/
    
    Dim latRad As Double, sdRad As Double, HAarg As Double, HA As Double
    
    latRad = degToRad(lat)
    sdRad = degToRad(solarDec)
    
    HAarg = (Cos(degToRad(90.833)) / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad))
    
    HA = (Acos(Cos(degToRad(90.833)) _
        / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad)))
    
    calcHourAngleSunset = -HA
    
End Function

Function calcHourAngleDusk(lat, solarDec, solardepression)
    
    '***********************************************************************/
    '* Name:    calcHourAngleDusk
    '* Type:    Function
    '* Purpose: calculate the hour angle of the sun at dusk for the
    '*         latitude
    '*         for user selected solar depression below horizon
    '* Arguments:
    '*   lat : latitude of observer in degrees
    '*   solarDec : declination angle of sun in degrees
    '*   solardepression: angle of sun below horizon in degrees
    '* Return value:
    '*   hour angle of dusk in radians
    '***********************************************************************/
    
    Dim latRad As Double, sdRad As Double, HAarg As Double, HA As Double
    
    latRad = degToRad(lat)
    sdRad = degToRad(solarDec)
    
    HAarg = (Cos(degToRad(90 + solardepression)) / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad))
    
    HA = (Acos(Cos(degToRad(90 + solardepression)) _
        / (Cos(latRad) * Cos(sdRad)) - Tan(latRad) * Tan(sdRad)))
    
    calcHourAngleDusk = -HA
    
End Function

Function calcDawnUTC(JD, latitude, longitude, solardepression)
    
    '***********************************************************************/
    '* Name:    calcDawnUTC
    '* Type:    Function
    '* Purpose: calculate the Universal Coordinated Time (UTC) of dawn
    '*         for the given day at the given location on earth
    '*         for user selected solar depression below horizon
    '* Arguments:
    '*   JD  : julian day
    '*   latitude : latitude of observer in degrees
    '*   longitude : longitude of observer in degrees
    '*   solardepression: angle of sun below the horizon in degrees
    '* Return value:
    '*   time in minutes from zero Z
    '***********************************************************************/
    
    Dim t As Double, eqtime As Double, solarDec As Double, hourangle As Double
    Dim delta As Double, timeDiff As Double, timeUTC As Double
    Dim newt As Double
    
    t = calcTimeJulianCent(JD)
    
    '        // *** First pass to approximate sunrise
    
    eqtime = calcEquationOfTime(t)
    solarDec = calcSunDeclination(t)
    hourangle = calcHourAngleSunrise(latitude, solarDec)
    
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    ' in minutes of time
    timeUTC = 720 + timeDiff - eqtime
    ' in minutes
    
    ' *** Second pass includes fractional jday in gamma calc
    
    newt = calcTimeJulianCent(calcJDFromJulianCent(t) + timeUTC / 1440#)
    eqtime = calcEquationOfTime(newt)
    solarDec = calcSunDeclination(newt)
    hourangle = calcHourAngleDawn(latitude, solarDec, solardepression)
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    timeUTC = 720 + timeDiff - eqtime
    ' in minutes
    
    calcDawnUTC = timeUTC
    
End Function

Function calcSunriseUTC(JD, latitude, longitude)
    
    '***********************************************************************/
    '* Name:    calcSunriseUTC
    '* Type:    Function
    '* Purpose: calculate the Universal Coordinated Time (UTC) of sunrise
    '*         for the given day at the given location on earth
    '* Arguments:
    '*   JD  : julian day
    '*   latitude : latitude of observer in degrees
    '*   longitude : longitude of observer in degrees
    '* Return value:
    '*   time in minutes from zero Z
    '***********************************************************************/
    
    Dim t As Double, eqtime As Double, solarDec As Double, hourangle As Double
    Dim delta As Double, timeDiff As Double, timeUTC As Double
    Dim newt As Double
    
    t = calcTimeJulianCent(JD)
    
    '        // *** First pass to approximate sunrise
    
    eqtime = calcEquationOfTime(t)
    solarDec = calcSunDeclination(t)
    hourangle = calcHourAngleSunrise(latitude, solarDec)
    
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    ' in minutes of time
    timeUTC = 720 + timeDiff - eqtime
    ' in minutes
    
    ' *** Second pass includes fractional jday in gamma calc
    
    newt = calcTimeJulianCent(calcJDFromJulianCent(t) + timeUTC / 1440#)
    eqtime = calcEquationOfTime(newt)
    solarDec = calcSunDeclination(newt)
    hourangle = calcHourAngleSunrise(latitude, solarDec)
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    timeUTC = 720 + timeDiff - eqtime
    ' in minutes
    
    calcSunriseUTC = timeUTC
    
End Function

Function calcSolNoonUTC(t, longitude)
    
    '***********************************************************************/
    '* Name:    calcSolNoonUTC
    '* Type:    Function
    '* Purpose: calculate the Universal Coordinated Time (UTC) of solar
    '*     noon for the given day at the given location on earth
    '* Arguments:
    '*   t : number of Julian centuries since J2000.0
    '*   longitude : longitude of observer in degrees
    '* Return value:
    '*   time in minutes from zero Z
    '***********************************************************************/
    
    Dim newt As Double, eqtime As Double, solarNoonDec As Double, solNoonUTC As Double
    
    newt = calcTimeJulianCent(calcJDFromJulianCent(t) + 0.5 + longitude / 360#)
    
    eqtime = calcEquationOfTime(newt)
    solarNoonDec = calcSunDeclination(newt)
    solNoonUTC = 720 + (longitude * 4) - eqtime
    
    calcSolNoonUTC = solNoonUTC
    
End Function

Function calcSunsetUTC(JD, latitude, longitude)
    
    '***********************************************************************/
    '* Name:    calcSunsetUTC
    '* Type:    Function
    '* Purpose: calculate the Universal Coordinated Time (UTC) of sunset
    '*         for the given day at the given location on earth
    '* Arguments:
    '*   JD  : julian day
    '*   latitude : latitude of observer in degrees
    '*   longitude : longitude of observer in degrees
    '* Return value:
    '*   time in minutes from zero Z
    '***********************************************************************/
    
    Dim t As Double, eqtime As Double, solarDec As Double, hourangle As Double
    Dim delta As Double, timeDiff As Double, timeUTC As Double
    Dim newt As Double
    
    t = calcTimeJulianCent(JD)
    
    '        // First calculates sunrise and approx length of day
    
    eqtime = calcEquationOfTime(t)
    solarDec = calcSunDeclination(t)
    hourangle = calcHourAngleSunset(latitude, solarDec)
    
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    timeUTC = 720 + timeDiff - eqtime
    
    '        // first pass used to include fractional day in gamma calc
    
    newt = calcTimeJulianCent(calcJDFromJulianCent(t) + timeUTC / 1440#)
    eqtime = calcEquationOfTime(newt)
    solarDec = calcSunDeclination(newt)
    hourangle = calcHourAngleSunset(latitude, solarDec)
    
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    timeUTC = 720 + timeDiff - eqtime
    '        // in minutes
    
    calcSunsetUTC = timeUTC
    
End Function

Function calcDuskUTC(JD, latitude, longitude, solardepression)
    
    '***********************************************************************/
    '* Name:    calcDuskUTC
    '* Type:    Function
    '* Purpose: calculate the Universal Coordinated Time (UTC) of dusk
    '*         for the given day at the given location on earth
    '*         for user selected solar depression below horizon
    '* Arguments:
    '*   JD  : julian day
    '*   latitude : latitude of observer in degrees
    '*   longitude : longitude of observer in degrees
    '*   solardepression: angle of sun below horizon
    '* Return value:
    '*   time in minutes from zero Z
    '***********************************************************************/
    
    Dim t As Double, eqtime As Double, solarDec As Double, hourangle As Double
    Dim delta As Double, timeDiff As Double, timeUTC As Double
    Dim newt As Double
    
    t = calcTimeJulianCent(JD)
    
    '        // First calculates sunrise and approx length of day
    
    eqtime = calcEquationOfTime(t)
    solarDec = calcSunDeclination(t)
    hourangle = calcHourAngleSunset(latitude, solarDec)
    
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    timeUTC = 720 + timeDiff - eqtime
    
    '        // first pass used to include fractional day in gamma calc
    
    newt = calcTimeJulianCent(calcJDFromJulianCent(t) + timeUTC / 1440#)
    eqtime = calcEquationOfTime(newt)
    solarDec = calcSunDeclination(newt)
    hourangle = calcHourAngleDusk(latitude, solarDec, solardepression)
    
    delta = longitude - radToDeg(hourangle)
    timeDiff = 4 * delta
    timeUTC = 720 + timeDiff - eqtime
    '        // in minutes
    
    calcDuskUTC = timeUTC
    
End Function

Function Dawn(lat, lon, year, month, day, timezone, dlstime, solardepression)
    
    '***********************************************************************/
    '* Name:    dawn
    '* Type:    Main Function called by spreadsheet
    '* Purpose: calculate time of dawn  for the entered date
    '*     and location.
    '* For latitudes greater than 72 degrees N and S, calculations are
    '* accurate to within 10 minutes. For latitudes less than +/- 72°
    '* accuracy is approximately one minute.
    '* Arguments:
    '   latitude = latitude (decimal degrees)
    '   longitude = longitude (decimal degrees)
    '    NOTE: longitude is negative for western hemisphere for input cells
    '          in the spreadsheet for calls to the functions named
    '          sunrise, solarnoon, and sunset. Those functions convert the
    '          longitude to positive for the western hemisphere for calls to
    '          other functions using the original sign convention
    '          from the NOAA javascript code.
    '   year = year
    '   month = month
    '   day = day
    '   timezone = time zone hours relative to GMT/UTC (hours)
    '   dlstime = daylight savings time (0 = no, 1 = yes) (hours)
    '   solardepression = angle of sun below horizon in degrees
    '* Return value:
    '*   dawn time in local time (days)
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double, JD As Double
    Dim riseTimeGMT As Double, riseTimeLST As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    JD = calcJD(year, month, day)
    
    '            // Calculate sunrise for this date
    riseTimeGMT = calcDawnUTC(JD, latitude, longitude, solardepression)
    
    '            //  adjust for time zone and daylight savings time in minutes
    riseTimeLST = riseTimeGMT + (60 * timezone) + (dlstime * 60)
    
    '            //  convert to days
    Dawn = riseTimeLST / 1440
    
End Function

Function sunrise(lat, lon, year, month, day, timezone, dlstime)
    
    '***********************************************************************/
    '* Name:    sunrise
    '* Type:    Main Function called by spreadsheet
    '* Purpose: calculate time of sunrise  for the entered date
    '*     and location.
    '* For latitudes greater than 72 degrees N and S, calculations are
    '* accurate to within 10 minutes. For latitudes less than +/- 72°
    '* accuracy is approximately one minute.
    '* Arguments:
    '   latitude = latitude (decimal degrees)
    '   longitude = longitude (decimal degrees)
    '    NOTE: longitude is negative for western hemisphere for input cells
    '          in the spreadsheet for calls to the functions named
    '          sunrise, solarnoon, and sunset. Those functions convert the
    '          longitude to positive for the western hemisphere for calls to
    '          other functions using the original sign convention
    '          from the NOAA javascript code.
    '   year = year
    '   month = month
    '   day = day
    '   timezone = time zone hours relative to GMT/UTC (hours)
    '   dlstime = daylight savings time (0 = no, 1 = yes) (hours)
    '* Return value:
    '*   sunrise time in local time (days)
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double, JD As Double
    Dim riseTimeGMT As Double, riseTimeLST As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    JD = calcJD(year, month, day)
    
    '            // Calculate sunrise for this date
    riseTimeGMT = calcSunriseUTC(JD, latitude, longitude)
    
    '            //  adjust for time zone and daylight savings time in minutes
    riseTimeLST = riseTimeGMT + (60 * timezone) + (dlstime * 60)
    
    '            //  convert to days
    sunrise = riseTimeLST / 1440
    
End Function

Function solarnoon(lat, lon, year, month, day, timezone, dlstime)
    
    '***********************************************************************/
    '* Name:    solarnoon
    '* Type:    Main Function called by spreadsheet
    '* Purpose: calculate the Universal Coordinated Time (UTC) of solar
    '*     noon for the given day at the given location on earth
    '* Arguments:
    '    year
    '    month
    '    day
    '*   longitude : longitude of observer in degrees
    '    NOTE: longitude is negative for western hemisphere for input cells
    '          in the spreadsheet for calls to the functions named
    '          sunrise, solarnoon, and sunset. Those functions convert the
    '          longitude to positive for the western hemisphere for calls to
    '          other functions using the original sign convention
    '          from the NOAA javascript code.
    '* Return value:
    '*   time of solar noon in local time days
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double, JD As Double
    Dim t As Double, newt As Double, eqtime As Double
    Dim solarNoonDec As Double, solNoonUTC As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    JD = calcJD(year, month, day)
    t = calcTimeJulianCent(JD)
    
    newt = calcTimeJulianCent(calcJDFromJulianCent(t) + 0.5 + longitude / 360#)
    
    eqtime = calcEquationOfTime(newt)
    solarNoonDec = calcSunDeclination(newt)
    solNoonUTC = 720 + (longitude * 4) - eqtime
    
    '            //  adjust for time zone and daylight savings time in minutes
    solarnoon = solNoonUTC + (60 * timezone) + (dlstime * 60)
    
    '            //  convert to days
    solarnoon = solarnoon / 1440
    
End Function

Function sunset(lat, lon, year, month, day, timezone, dlstime)
    
    '***********************************************************************/
    '* Name:    sunset
    '* Type:    Main Function called by spreadsheet
    '* Purpose: calculate time of sunrise and sunset for the entered date
    '*     and location.
    '* For latitudes greater than 72 degrees N and S, calculations are
    '* accurate to within 10 minutes. For latitudes less than +/- 72°
    '* accuracy is approximately one minute.
    '* Arguments:
    '   latitude = latitude (decimal degrees)
    '   longitude = longitude (decimal degrees)
    '    NOTE: longitude is negative for western hemisphere for input cells
    '          in the spreadsheet for calls to the functions named
    '          sunrise, solarnoon, and sunset. Those functions convert the
    '          longitude to positive for the western hemisphere for calls to
    '          other functions using the original sign convention
    '          from the NOAA javascript code.
    '   year = year
    '   month = month
    '   day = day
    '   timezone = time zone hours relative to GMT/UTC (hours)
    '   dlstime = daylight savings time (0 = no, 1 = yes) (hours)
    '* Return value:
    '*   sunset time in local time (days)
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double, JD As Double
    Dim setTimeGMT As Double, setTimeLST As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    JD = calcJD(year, month, day)
    
    '           // Calculate sunset for this date
    setTimeGMT = calcSunsetUTC(JD, latitude, longitude)
    
    '            //  adjust for time zone and daylight savings time in minutes
    setTimeLST = setTimeGMT + (60 * timezone) + (dlstime * 60)
    
    '            //  convert to days
    sunset = setTimeLST / 1440
    
End Function

Function Dusk(lat, lon, year, month, day, timezone, dlstime, solardepression)
    
    '***********************************************************************/
    '* Name:    dusk
    '* Type:    Main Function called by spreadsheet
    '* Purpose: calculate time of sunrise and sunset for the entered date
    '*     and location.
    '* For latitudes greater than 72 degrees N and S, calculations are
    '* accurate to within 10 minutes. For latitudes less than +/- 72°
    '* accuracy is approximately one minute.
    '* Arguments:
    '   latitude = latitude (decimal degrees)
    '   longitude = longitude (decimal degrees)
    '    NOTE: longitude is negative for western hemisphere for input cells
    '          in the spreadsheet for calls to the functions named
    '          sunrise, solarnoon, and sunset. Those functions convert the
    '          longitude to positive for the western hemisphere for calls to
    '          other functions using the original sign convention
    '          from the NOAA javascript code.
    '   year = year
    '   month = month
    '   day = day
    '   timezone = time zone hours relative to GMT/UTC (hours)
    '   dlstime = daylight savings time (0 = no, 1 = yes) (hours)
    '   solardepression = angle of sun below horizon in degrees
    '* Return value:
    '*   dusk time in local time (days)
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double, JD As Double
    Dim setTimeGMT As Double, setTimeLST As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    JD = calcJD(year, month, day)
    
    '           // Calculate sunset for this date
    setTimeGMT = calcDuskUTC(JD, latitude, longitude, solardepression)
    
    '            //  adjust for time zone and daylight savings time in minutes
    setTimeLST = setTimeGMT + (60 * timezone) + (dlstime * 60)
    
    '            //  convert to days
    Dusk = setTimeLST / 1440
    
End Function

Function solarazimuth(lat, lon, year, month, day, _
        hours, minutes, seconds, timezone, dlstime)
    
    '***********************************************************************/
    '* Name:    solarazimuth
    '* Type:    Main Function
    '* Purpose: calculate solar azimuth (deg from north) for the entered
    '*          date, time and location. Returns -999999 if darker than twilight
    '*
    '* Arguments:
    '*   latitude, longitude, year, month, day, hour, minute, second,
    '*   timezone, daylightsavingstime
    '* Return value:
    '*   solar azimuth in degrees from north
    '*
    '* Note: solarelevation and solarazimuth functions are identical
    '*       and could be converted to a VBA subroutine that would return
    '*       both values.
    '*
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double
    Dim zone As Double, daySavings As Double
    Dim hh As Double, mm As Double, ss As Double, timenow As Double
    Dim JD As Double, t As Double, R As Double
    Dim alpha As Double, theta As Double, Etime As Double, eqtime As Double
    Dim solarDec As Double, earthRadVec As Double, solarTimeFix As Double
    Dim trueSolarTime As Double, hourangle As Double, harad As Double
    Dim csz As Double, zenith As Double, azDenom As Double, azRad As Double
    Dim azimuth As Double, exoatmElevation As Double
    Dim step1 As Double, step2 As Double, step3 As Double
    Dim refractionCorrection As Double, te As Double, solarzen As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    'change time zone to ppositive hours in western hemisphere
    zone = timezone * -1
    daySavings = dlstime * 60
    hh = hours - (daySavings / 60)
    mm = minutes
    ss = seconds
    
    '//    timenow is GMT time for calculation in hours since 0Z
    timenow = hh + mm / 60 + ss / 3600 + zone
    
    JD = calcJD(year, month, day)
    t = calcTimeJulianCent(JD + timenow / 24#)
    R = calcSunRadVector(t)
    alpha = calcSunRtAscension(t)
    theta = calcSunDeclination(t)
    Etime = calcEquationOfTime(t)
    
    eqtime = Etime
    solarDec = theta '//    in degrees
    earthRadVec = R
    
    solarTimeFix = eqtime - 4# * longitude + 60# * zone
    trueSolarTime = hh * 60# + mm + ss / 60# + solarTimeFix
    '//    in minutes
    
    Do While (trueSolarTime > 1440)
        trueSolarTime = trueSolarTime - 1440
    Loop
    
    hourangle = trueSolarTime / 4# - 180#
    '//    Thanks to Louis Schwarzmayr for the next line:
    If (hourangle < -180) Then hourangle = hourangle + 360#
    
    harad = degToRad(hourangle)
    
    csz = Sin(degToRad(latitude)) * _
        Sin(degToRad(solarDec)) + _
        Cos(degToRad(latitude)) * _
        Cos(degToRad(solarDec)) * Cos(harad)
    
    If (csz > 1#) Then
        csz = 1#
    ElseIf (csz < -1#) Then
        csz = -1#
    End If
    
    zenith = radToDeg(Acos(csz))
    
    azDenom = (Cos(degToRad(latitude)) * Sin(degToRad(zenith)))
    
    If (Abs(azDenom) > 0.001) Then
        azRad = ((Sin(degToRad(latitude)) * _
            Cos(degToRad(zenith))) - _
            Sin(degToRad(solarDec))) / azDenom
        If (Abs(azRad) > 1#) Then
            If (azRad < 0) Then
                azRad = -1#
            Else
                azRad = 1#
            End If
        End If
        
        azimuth = 180# - radToDeg(Acos(azRad))
        
        If (hourangle > 0#) Then
            azimuth = -azimuth
        End If
    Else
        If (latitude > 0#) Then
            azimuth = 180#
        Else
            azimuth = 0#
        End If
    End If
    If (azimuth < 0#) Then
        azimuth = azimuth + 360#
    End If
    
    exoatmElevation = 90# - zenith
    
    'beginning of complex expression commented out
    '            If (exoatmElevation > 85#) Then
    '                refractionCorrection = 0#
    '            Else
    '                te = Tan(degToRad(exoatmElevation))
    '                If (exoatmElevation > 5#) Then
    '                    refractionCorrection = 58.1 / te - 0.07 / (te * te * te) + _
        '                        0.000086 / (te * te * te * te * te)
    '                ElseIf (exoatmElevation > -0.575) Then
    '                    refractionCorrection = 1735# + exoatmElevation * _
        '                        (-518.2 + exoatmElevation * (103.4 + _
        '                        exoatmElevation * (-12.79 + _
        '                        exoatmElevation * 0.711)))
    '                Else
    '                    refractionCorrection = -20.774 / te
    '                End If
    '                refractionCorrection = refractionCorrection / 3600#
    '            End If
    'end of complex expression
    
    'beginning of simplified expression
    If (exoatmElevation > 85#) Then
        refractionCorrection = 0#
    Else
        te = Tan(degToRad(exoatmElevation))
        If (exoatmElevation > 5#) Then
            refractionCorrection = 58.1 / te - 0.07 / (te * te * te) + _
                0.000086 / (te * te * te * te * te)
        ElseIf (exoatmElevation > -0.575) Then
            step1 = (-12.79 + exoatmElevation * 0.711)
            step2 = (103.4 + exoatmElevation * (step1))
            step3 = (-518.2 + exoatmElevation * (step2))
            refractionCorrection = 1735# + exoatmElevation * (step3)
        Else
            refractionCorrection = -20.774 / te
        End If
        refractionCorrection = refractionCorrection / 3600#
    End If
    'end of simplified expression
    
    solarzen = zenith - refractionCorrection
    
    '            If (solarZen < 108#) Then
    solarazimuth = azimuth
    '              solarelevation = 90# - solarZen
    '              If (solarZen < 90#) Then
    '                coszen = Cos(degToRad(solarZen))
    '              Else
    '                coszen = 0#
    '              End If
    '            Else    '// do not report az & el after astro twilight
    '              solarazimuth = -999999
    '              solarelevation = -999999
    '              coszen = -999999
    '            End If
    
End Function

Function solarelevation(lat, lon, year, month, day, _
        hours, minutes, seconds, timezone, dlstime)
    
    '***********************************************************************/
    '* Name:    solarazimuth
    '* Type:    Main Function
    '* Purpose: calculate solar azimuth (deg from north) for the entered
    '*          date, time and location. Returns -999999 if darker than twilight
    '*
    '* Arguments:
    '*   latitude, longitude, year, month, day, hour, minute, second,
    '*   timezone, daylightsavingstime
    '* Return value:
    '*   solar azimuth in degrees from north
    '*
    '* Note: solarelevation and solarazimuth functions are identical
    '*       and could converted to a VBA subroutine that would return
    '*       both values.
    '*
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double
    Dim zone As Double, daySavings As Double
    Dim hh As Double, mm As Double, ss As Double, timenow As Double
    Dim JD As Double, t As Double, R As Double
    Dim alpha As Double, theta As Double, Etime As Double, eqtime As Double
    Dim solarDec As Double, earthRadVec As Double, solarTimeFix As Double
    Dim trueSolarTime As Double, hourangle As Double, harad As Double
    Dim csz As Double, zenith As Double, azDenom As Double, azRad As Double
    Dim azimuth As Double, exoatmElevation As Double
    Dim step1 As Double, step2 As Double, step3 As Double
    Dim refractionCorrection As Double, te As Double, solarzen As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    'change time zone to ppositive hours in western hemisphere
    zone = timezone * -1
    daySavings = dlstime * 60
    hh = hours - (daySavings / 60)
    mm = minutes
    ss = seconds
    
    '//    timenow is GMT time for calculation in hours since 0Z
    timenow = hh + mm / 60 + ss / 3600 + zone
    
    JD = calcJD(year, month, day)
    t = calcTimeJulianCent(JD + timenow / 24#)
    R = calcSunRadVector(t)
    alpha = calcSunRtAscension(t)
    theta = calcSunDeclination(t)
    Etime = calcEquationOfTime(t)
    
    eqtime = Etime
    solarDec = theta '//    in degrees
    earthRadVec = R
    
    solarTimeFix = eqtime - 4# * longitude + 60# * zone
    trueSolarTime = hh * 60# + mm + ss / 60# + solarTimeFix
    '//    in minutes
    
    Do While (trueSolarTime > 1440)
        trueSolarTime = trueSolarTime - 1440
    Loop
    
    hourangle = trueSolarTime / 4# - 180#
    '//    Thanks to Louis Schwarzmayr for the next line:
    If (hourangle < -180) Then hourangle = hourangle + 360#
    
    harad = degToRad(hourangle)
    
    csz = Sin(degToRad(latitude)) * _
        Sin(degToRad(solarDec)) + _
        Cos(degToRad(latitude)) * _
        Cos(degToRad(solarDec)) * Cos(harad)
    
    If (csz > 1#) Then
        csz = 1#
    ElseIf (csz < -1#) Then
        csz = -1#
    End If
    
    zenith = radToDeg(Acos(csz))
    
    azDenom = (Cos(degToRad(latitude)) * Sin(degToRad(zenith)))
    
    If (Abs(azDenom) > 0.001) Then
        azRad = ((Sin(degToRad(latitude)) * _
            Cos(degToRad(zenith))) - _
            Sin(degToRad(solarDec))) / azDenom
        If (Abs(azRad) > 1#) Then
            If (azRad < 0) Then
                azRad = -1#
            Else
                azRad = 1#
            End If
        End If
        
        azimuth = 180# - radToDeg(Acos(azRad))
        
        If (hourangle > 0#) Then
            azimuth = -azimuth
        End If
    Else
        If (latitude > 0#) Then
            azimuth = 180#
        Else
            azimuth = 0#
        End If
    End If
    If (azimuth < 0#) Then
        azimuth = azimuth + 360#
    End If
    
    exoatmElevation = 90# - zenith
    
    'beginning of complex expression commented out
    '            If (exoatmElevation > 85#) Then
    '                refractionCorrection = 0#
    '            Else
    '                te = Tan(degToRad(exoatmElevation))
    '                If (exoatmElevation > 5#) Then
    '                    refractionCorrection = 58.1 / te - 0.07 / (te * te * te) + _
        '                        0.000086 / (te * te * te * te * te)
    '                ElseIf (exoatmElevation > -0.575) Then
    '                    refractionCorrection = 1735# + exoatmElevation * _
        '                        (-518.2 + exoatmElevation * (103.4 + _
        '                        exoatmElevation * (-12.79 + _
        '                        exoatmElevation * 0.711)))
    '                Else
    '                    refractionCorrection = -20.774 / te
    '                End If
    '                refractionCorrection = refractionCorrection / 3600#
    '            End If
    'end of complex expression
    
    'beginning of simplified expression
    If (exoatmElevation > 85#) Then
        refractionCorrection = 0#
    Else
        te = Tan(degToRad(exoatmElevation))
        If (exoatmElevation > 5#) Then
            refractionCorrection = 58.1 / te - 0.07 / (te * te * te) + _
                0.000086 / (te * te * te * te * te)
        ElseIf (exoatmElevation > -0.575) Then
            step1 = (-12.79 + exoatmElevation * 0.711)
            step2 = (103.4 + exoatmElevation * (step1))
            step3 = (-518.2 + exoatmElevation * (step2))
            refractionCorrection = 1735# + exoatmElevation * (step3)
        Else
            refractionCorrection = -20.774 / te
        End If
        refractionCorrection = refractionCorrection / 3600#
    End If
    'end of simplified expression
    
    solarzen = zenith - refractionCorrection
    
    '            If (solarZen < 108#) Then
    '              solarazimuth = azimuth
    solarelevation = 90# - solarzen
    '              If (solarZen < 90#) Then
    '                coszen = Cos(degToRad(solarZen))
    '              Else
    '                coszen = 0#
    '              End If
    '            Else    '// do not report az & el after astro twilight
    '              solarazimuth = -999999
    '              solarelevation = -999999
    '              coszen = -999999
    '            End If
    
End Function

Sub solarposition(lat, lon, year, month, day, _
        hours, minutes, seconds, timezone, dlstime, solarazimuth, solarelevation)
    
    '***********************************************************************/
    '* Name:    solarazimuth
    '* Type:    Main Function
    '* Purpose: calculate solar azimuth (deg from north) for the entered
    '*          date, time and location. Returns -999999 if darker than twilight
    '*
    '* Arguments:
    '*   latitude, longitude, year, month, day, hour, minute, second,
    '*   timezone, daylightsavingstime
    '* Return value:
    '*   solar azimuth in degrees from north
    '*
    '* Note: solarelevation and solarazimuth functions are identical
    '*       and could converted to a VBA subroutine that would return
    '*       both values.
    '*
    '***********************************************************************/
    
    Dim longitude As Double, latitude As Double
    Dim zone As Double, daySavings As Double
    Dim hh As Double, mm As Double, ss As Double, timenow As Double
    Dim JD As Double, t As Double, R As Double
    Dim alpha As Double, theta As Double, Etime As Double, eqtime As Double
    Dim solarDec As Double, earthRadVec As Double, solarTimeFix As Double
    Dim trueSolarTime As Double, hourangle As Double, harad As Double
    Dim csz As Double, zenith As Double, azDenom As Double, azRad As Double
    Dim azimuth As Double, exoatmElevation As Double
    Dim step1 As Double, step2 As Double, step3 As Double
    Dim refractionCorrection As Double, te As Double, solarzen As Double
    
    ' change sign convention for longitude from negative to positive in western hemisphere
    longitude = lon * -1
    latitude = lat
    If (latitude > 89.8) Then latitude = 89.8
    If (latitude < -89.8) Then latitude = -89.8
    
    'change time zone to ppositive hours in western hemisphere
    zone = timezone * -1
    daySavings = dlstime * 60
    hh = hours - (daySavings / 60)
    mm = minutes
    ss = seconds
    
    '//    timenow is GMT time for calculation in hours since 0Z
    timenow = hh + mm / 60 + ss / 3600 + zone
    
    JD = calcJD(year, month, day)
    t = calcTimeJulianCent(JD + timenow / 24#)
    R = calcSunRadVector(t)
    alpha = calcSunRtAscension(t)
    theta = calcSunDeclination(t)
    Etime = calcEquationOfTime(t)
    
    eqtime = Etime
    solarDec = theta '//    in degrees
    earthRadVec = R
    
    solarTimeFix = eqtime - 4# * longitude + 60# * zone
    trueSolarTime = hh * 60# + mm + ss / 60# + solarTimeFix
    '//    in minutes
    
    Do While (trueSolarTime > 1440)
        trueSolarTime = trueSolarTime - 1440
    Loop
    
    hourangle = trueSolarTime / 4# - 180#
    '//    Thanks to Louis Schwarzmayr for the next line:
    If (hourangle < -180) Then hourangle = hourangle + 360#
    
    harad = degToRad(hourangle)
    
    csz = Sin(degToRad(latitude)) * _
        Sin(degToRad(solarDec)) + _
        Cos(degToRad(latitude)) * _
        Cos(degToRad(solarDec)) * Cos(harad)
    
    If (csz > 1#) Then
        csz = 1#
    ElseIf (csz < -1#) Then
        csz = -1#
    End If
    
    zenith = radToDeg(Acos(csz))
    
    azDenom = (Cos(degToRad(latitude)) * Sin(degToRad(zenith)))
    
    If (Abs(azDenom) > 0.001) Then
        azRad = ((Sin(degToRad(latitude)) * _
            Cos(degToRad(zenith))) - _
            Sin(degToRad(solarDec))) / azDenom
        If (Abs(azRad) > 1#) Then
            If (azRad < 0) Then
                azRad = -1#
            Else
                azRad = 1#
            End If
        End If
        
        azimuth = 180# - radToDeg(Acos(azRad))
        
        If (hourangle > 0#) Then
            azimuth = -azimuth
        End If
    Else
        If (latitude > 0#) Then
            azimuth = 180#
        Else
            azimuth = 0#
        End If
    End If
    If (azimuth < 0#) Then
        azimuth = azimuth + 360#
    End If
    
    exoatmElevation = 90# - zenith
    
    'beginning of complex expression commented out
    '            If (exoatmElevation > 85#) Then
    '                refractionCorrection = 0#
    '            Else
    '                te = Tan(degToRad(exoatmElevation))
    '                If (exoatmElevation > 5#) Then
    '                    refractionCorrection = 58.1 / te - 0.07 / (te * te * te) + _
        '                        0.000086 / (te * te * te * te * te)
    '                ElseIf (exoatmElevation > -0.575) Then
    '                    refractionCorrection = 1735# + exoatmElevation * _
        '                        (-518.2 + exoatmElevation * (103.4 + _
        '                        exoatmElevation * (-12.79 + _
        '                        exoatmElevation * 0.711)))
    '                Else
    '                    refractionCorrection = -20.774 / te
    '                End If
    '                refractionCorrection = refractionCorrection / 3600#
    '            End If
    'end of complex expression
    
    
    'beginning of simplified expression
    If (exoatmElevation > 85#) Then
        refractionCorrection = 0#
    Else
        te = Tan(degToRad(exoatmElevation))
        If (exoatmElevation > 5#) Then
            refractionCorrection = 58.1 / te - 0.07 / (te * te * te) + _
                0.000086 / (te * te * te * te * te)
        ElseIf (exoatmElevation > -0.575) Then
            step1 = (-12.79 + exoatmElevation * 0.711)
            step2 = (103.4 + exoatmElevation * (step1))
            step3 = (-518.2 + exoatmElevation * (step2))
            refractionCorrection = 1735# + exoatmElevation * (step3)
        Else
            refractionCorrection = -20.774 / te
        End If
        refractionCorrection = refractionCorrection / 3600#
    End If
    'end of simplified expression
    
    
    solarzen = zenith - refractionCorrection
    
    '            If (solarZen < 108#) Then
    solarazimuth = azimuth
    solarelevation = 90# - solarzen
    '              If (solarZen < 90#) Then
    '                coszen = Cos(degToRad(solarZen))
    '              Else
    '                coszen = 0#
    '              End If
    '            Else    '// do not report az & el after astro twilight
    '              solarazimuth = -999999
    '              solarelevation = -999999
    '              coszen = -999999
    '            End If
    
End Sub

Public Function Pi()
    Pi = 4 * Atn(1)
End Function

Public Function Floor(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
    Floor = Int(X / Factor) * Factor
End Function

Public Function Acos(ByVal Arg1 As Double)
    Acos = Atn(-Arg1 / Sqr(-Arg1 * Arg1 + 1)) + 2 * Atn(1)
End Function

Public Function Asin(ByVal Arg1 As Double)
    Asin = Atn(Arg1 / Sqr(-Arg1 * Arg1 + 1))
End Function

Public Function Atan2(ByVal Y As Double, ByVal X As Double) As Double
    If X = 0 And Y = 0 Then
        Atan2 = 0
    ElseIf X <> 0 Then
        Atan2 = Atn(Y / X) - Pi * (X < 0) * (2 * (Y < 0) - 1)
    Else
        Atan2 = Pi / 2 * (2 * (Y > 0) - 1)
    End If
End Function
 
  • הוסף לסימניות
  • #4
נכתב ע"י moishy;2441726:
יש פרויקט שנכתב בJAVA ע"י אליהו הרשפלד לחישוב זמני היום, הומר לדוטנט ע"י יצחק, והותאם לVBA ע"י. יש 122 זמנים המחושבים ע"י הפרויקט הנ"ל. אם תרצה אוכל להעלות את קבצי הDLL ו/או את קוד המקור.
(..)
ראשית הדגמה קצרה כיצד להשתמש בו בדוגמאות אלו אני משתמש עם הקיארדונציות של ירושלים):
זמן טלית ותפילין (לשיטות שהוא מחושב כאשר השמש נמצאת 11.5 מעלות מתחת קו האופק)
קוד:
Format(Dawn(31.771959,35.217018,2017,02,15,2,0,11.5),"HH:MM:SS AMPM")
לילה לר"ת (לשיטות שהוא מחושב כאשר השמש נמצאת 16.1 מעלות מתחת קו האופק)
קוד:
Format(Dusk(31.771959,35.217018,2017,02,15,2,0,16.1),"HH:MM:SS AMPM")
תשוה את התוצאות עם התוצאות מאתר זה: https://www.myzmanim.com
(...)
[/CODE]

וואי....!
זה חלום שלי כבר הרבה זמן, זמני היום באקסס.
איך מחשבים גובה? (800 מטר בירושלים)

ואשמח לקבל את הקובץ המוכן, (אני לא כ"כ מקצועי בVB, ומנסה עכשיו ללמוד קצת...)
אבל לא בDLL (שאין לי מושג איך משתמשים בזה)
אלא בפונקציה.
תודה רבה!!

אגב, אני ממש נהנה מכל הפרוייקטים שהעלת לכאן
תודה רבה.
 
  • הוסף לסימניות
  • #5
את הפרוייקט לא המרתי לVBA, רק ביצעתי התאמות לגירסת הדוטנט כדי שיוכלו להשתמש בDLLים מתוך VBA.
 
  • הוסף לסימניות
  • #6
בכל אופן, מה החישוב של הגובה?
בעמוד השחר יש הפרש של 2 דק' מ"עיתים לבינה"
ובשקיעה 5 דק'.
חצות, ר"ת, זמן טו"ת ושקיעה מישורית, אותו דבר כמו עיתים לבינה.
 
  • הוסף לסימניות
  • #7
מצו"ב בקובץ אקסס
אפשרות כמובן לשחק עם זה בלי סוף, בשאילתות, VBA ועוד.

(המעלות משותפות ללפני השקיעה ואחרי)
 

קבצים מצורפים

  • זמני היום.rar
    KB 74.8 · צפיות: 162
  • הוסף לסימניות
  • #8
נכתב ע"י מענטש אמיתי;2442531:
בכל אופן, מה החישוב של הגובה?
בעמוד השחר יש הפרש של 2 דק' מ"עיתים לבינה"
ובשקיעה 5 דק'.
חצות, ר"ת, זמן טו"ת ושקיעה מישורית, אותו דבר כמו עיתים לבינה.


אין לי עיתים לבינה
אבל בשקיעה ההבדל כנראה בגלל הגובה (וכן גם בנץ הנראה),
בעוד שאר הזמנים מחושבים לפי המישורי.
 
  • הוסף לסימניות
  • #9
נכתב ע"י moishy;2442502:
את הפרוייקט לא המרתי לVBA, רק ביצעתי התאמות לגירסת הדוטנט כדי שיוכלו להשתמש בDLLים מתוך VBA.

יש סיכוי להעיז לבקש הסבר קצר על זה?
 
  • הוסף לסימניות
  • #10
לגבי הקוד של NOAA (האקסל) שמוישי הביא מותאם ל-VBA זה רק למישור בגובה פני הים.
ואגב להם עצמם כבר יש היום פרוייקט מעודכן יותר, לא ידוע לי אם גם ב-VBA
(הישן, והחדש ויש הבדלים קטנים ביניהם).

בפרוייקט השני של אליהו הרשפלד יש כפי שמוישי כתב 122 זמנים / פונקציות וביניהם גם חישוב לפי גובה.
מוישי נשמח אם תעלה את קבצי הDLL ו/או את קוד המקור
 
  • הוסף לסימניות
  • #11
בבקשה.
כמובן צריך לבצע רישום לDLLים באמצעות RegAsm, לדוגמא:
קוד:
C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe /tlb /codebase "C:\Users\User\Desktop\zman\Zmanim.dll"
C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe /tlb /codebase "C:\Users\User\Desktop\zman\Zmanim.TzDatebase.dll"
קוד המקור כבד מידי, מי שרוצה אותו, שישלח לי מייל בפרטי ואשלח לו.
 

קבצים מצורפים

  • Compiled DLLs.zip
    KB 194.7 · צפיות: 74
  • הוסף לסימניות
  • #12
אגב, זמני עיתים לבינה מגיעים מתוכנת חזון שמים של הרב איתן ציקוני. לשאלתי עד כמה הזמנים שלו מדוייקים השיב שאיננו יודע.
קיימים אלגוריתמים שונים וכל אחד מחזיר תוצאה שונה, עם מה הדיוק המקסימלי, לה' הפתרונים.
 
  • הוסף לסימניות
  • #13
אכן כך גם אמר הרב ידידה מנת שהו"ל את הספר זמני ההלכה למעשה, והזמנים שונים במעט מאיתן צקוני, שהם ניסו לבדוק מה השוני ביניהם, ואין בידם הפיתרון.
הסיבה היא מכיון שהחישוב תלוי בהרבה פרמטרים מסובכים של רפרקציה (שבירת קרני השמש), משולשים כדוריים ועוד
למעשה ולדינא אכן כותבים כל בעלי הלוחות להחמיר בדאורייתות לפחות בדקה בזמני היום, מכיוון שהרי בלוחות תמיד מעגלים את הדקה, וכן יש כל יום שינויים בזמני הנץ והשקיעה הנראים בעקבות מזג האויר ועוד.
 
  • הוסף לסימניות
  • #14
נכתב ע"י shsh654;2443920:
אכן כך גם אמר הרב ידידה מנת שהו"ל את הספר זמני ההלכה למעשה, והזמנים שונים במעט מאיתן צקוני, שהם ניסו לבדוק מה השוני ביניהם, ואין בידם הפיתרון.
הסיבה היא מכיון שהחישוב תלוי בהרבה פרמטרים מסובכים של רפרקציה (שבירת קרני השמש), משולשים כדוריים ועוד
למעשה ולדינא אכן כותבים כל בעלי הלוחות להחמיר בדאורייתות לפחות בדקה בזמני היום, מכיוון שהרי בלוחות תמיד מעגלים את הדקה, וכן יש כל יום שינויים בזמני הנץ והשקיעה הנראים בעקבות מזג האויר ועוד.

ולפיכך ממשיכה להיות לא ברורה הנהגתו של עיתים לבינה שמציין (בעקבות הרב מנת) חלקי דקות.
 
  • הוסף לסימניות
  • #15
נכתב ע"י moishy;2443874:
בבקשה.
כמובן צריך לבצע רישום לDLLים באמצעות RegAsm, לדוגמא:
קוד:
C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe /tlb /codebase "C:\Users\User\Desktop\zman\Zmanim.dll"
C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe /tlb /codebase "C:\Users\User\Desktop\zman\Zmanim.TzDatebase.dll"
קוד המקור כבד מידי, מי שרוצה אותו, שישלח לי מייל בפרטי ואשלח לו.

אפשר לקבל הסבר איך משתמשים בזה?
ומה זה הפונקציה "דמו"?

לי בכל אופן זה מה שיצא בינתיים (ע"פ עיתים לבינה, וחזון שמיים)
זה שונה מהם במקס' חצי דקה.
(אני רק מתחיל באקסס, אז לא לצחוק...
אבל אם יש עצות איך לכתוב יותר טוב, אני רוצה לשמוע!!)
 

קבצים מצורפים

  • זמני היום.rar
    KB 154.7 · צפיות: 86
  • הוסף לסימניות
  • #16
בהשוואה לזמנים של הרב מנת, הבדל זמנים של עד 20 שניות.
ובחלק גדול מהשנה פחות מ-6 שניות הבדל (שזה בעצם 0 שניות הבדל כי הרב מנת מחלק את הדקה ל-10)
(אולי עם החישוב החדש של NOAA זה יהיה מדויק...)
 
  • הוסף לסימניות
  • #17
מצו"ב שיטת החישוב החדשה של NOAA, הפעם אקסל בלי VBA, פשוט נוסחאות בתאים עצמם.

ואם מעניין גם אתכם פילוח הנתונים:
ההבדלים בין שתי שיטות החישוב של NOAA (החדש והישן) נעים בין 0 ל- 20 שניות לאורך השנה.
במקרה של הרב מנת, ההפרש בינו ל-NOAA גדל בשיטת החישוב החדשה,
אבל האמת היא שאי אפשר כלל להשוות ביניהם, מכיוון שהרב מנת נותן חישוב קבוע למחזור של 4 שנים לועזיות, בעוד NOAA וכן הרב איתן צקוני מחשבים כל שנה לגופה.
מעניין להשוות את שיטת החישוב החדשה של NOAA המצו"ב, מול הרב צקוני / עיתים לבינה.
 

קבצים מצורפים

  • NOAA_Solar_Calculations_year.xls
    KB 401.5 · צפיות: 121
  • הוסף לסימניות
  • #18
טוב, זה הקובץ בינתיים עם כל הזמנים מ"עיתים לבינה" (חוץ מהנץ הנראה, והשקיעה הנראית)
אם יש למישהו את החישוב של הנץ הנראה (בשקיעה הנראית ההפרש קבוע כל השנה)
או את צורת החישוב, אשמח לקבל.

ואגב, מישהו יודע איך מבטלים בדוח את הפסים האפורים לסירוגין בAccsss 2007 והלאה?
מישהו שם החליט שככה יהיו כל הדוחות ואי אפשר לבטל!
(האפשרות "הצג נתונים בלבד" מבטלת גם את התוויות)
תודה רבה
 

קבצים מצורפים

  • זמני היום חדש.rar
    KB 179.7 · צפיות: 112
  • הוסף לסימניות
  • #19
נכתב ע"י מענטש אמיתי;2446147:
ואגב, מישהו יודע איך מבטלים בדוח את הפסים האפורים לסירוגין בAccsss 2007 והלאה?
מישהו שם החליט שככה יהיו כל הדוחות ואי אפשר לבטל!
(האפשרות "הצג נתונים בלבד" מבטלת גם את התוויות)
תודה רבה

אתה מתכוון לזה?
(זה לא דו"ח, אבל אותו דבר בטופס)

אח"כ חשבתי שבגליון נתונים זה אכן לא פותר את זה... אבל בדו"ח הרי אין גליון נתונים...
 

קבצים מצורפים

  • לכידה.PNG
    KB 16.3 · צפיות: 74
  • הוסף לסימניות
  • #20
זה בעיקר היה חשוב לי בדו"ח.
תודה רבה!
 

פרוגבוט

תוכן שיווקי
פרסומת

פוסטים חדשים שאולי לא קראת....

הכותרת לא באה להתריס היא באה להדגיש מצב
ולא לא באתי לומר שאבא או אמא עם ילד או שניים זה לא אתגר
אבל שימו לב
בעוד אתם בונים על ההורים לרוב פסח ולכן מכשירים פיסת שיש קטן לפינת קפה. מדף במקרר. ובארון
כי מילא רוב החג נהייה אצל ההורים
ההורים והרווקים בבית קורעים את עצמם [תזכרו זה לא היה כזה מזמן]
כן אמא שלך לא נחה כבר 3 שבועות

להפוך בית שלם 100+ מטר של ארונות כיורים שולחנות מטבח סלון כיסאות מזווה מיטות
לכשר לפסח
לאפשרות שאתם וילדכם הסתובבו בחופשיות עם מצה ואפיקומן שסבא קנה
לא נכנסתי להוצאות המטורפות שקצת עוברות לידכם. למה שתקנו מצות יין או חסה או נייר כסף לציפוי המטבח
ושוב לא בהאשמה ולא בטרוניה אלא כנתון מציאותי
אז זו''צ יקר קצת שימת לב
לפרגן לבוא לעזור חצי יום
לפרגן ארוחה לעובדים בבית [הבית שלך חמץ המטבח שלהם במרפסת שרות]
לתת מילה טובה או שוקולד
והחשוב מכל
מעשרות להורים
הם חשובים יותר מכל כולל ארגון או קמחה דפסחא הם ההורים שלך

והם יממנו לך את ארוחות וסעודות החג
בס"ד

ההבדל בין נוכלות לבין כישלון



לפני כחודש נערך בבני ברק מיפגש מאוד מעניין של גוף הנקרא "הפורום להגנת הצרכן" והוא עסק בעיקר בדרכים למניעת נפילות נדל"ן בהם הציבור החרדי "מומחה" ליפול חזור ונפול.

הנוכחים, מומחים איש איש בתחומו, תיארו את הנוכלויות הרווחות היום ותיארו בצבעים קודרים ואמיתיים את המצב בכי רע, היו שם גדולי הדיינים שדיברו על הצורך להבטיח שהדור השני לא עושה שטויות עם הדירה שקיבלו מההורים וכן הלאה.

כאשר ר' איצ'ה דזיאלובסקי העניק לי את רשות המילה האחרונה (בגלל שאיחרתי – הרגל נעשה טבע) בקשתי מהנוכחים שלא יישפכו את התינוק אם המים, כלומר שלא יביאו אנשים למצב שבו הם חושדים בכל מה שלא זז שהוא נוכלות, הדבר הזה טענתי עלול להביא לשיתוק מוחלט של שוק השקעות הנדל"ן החרדי אשר היה והינו הקטליזטור הראשי של הציבור החרדי בדרכו לנישואי ילדים ברוגע ושלווה, המסר המרכזי של שתי דקות הנאום שלי זה מה שאתם הולכים לקרוא באלף מילים הבאות: לא כל עסקה כושלת היא אשמת המשווק!

צרות אחרונות משכחות את הראשונות וכך שכחתי מזה לגמרי, אלא שהשבוע פורסמה כתבה בעיתון 'דה-מרקר' (מי שלא מכיר לא הפסיד - מלא באהבת כסף ושנאת חרדים) כתבת תחקיר עומק אודות תופעת העוקצים בציבור החרדי הכרוכים במבצעי 10/90 הזכורים לשימצה.

מה שלא אהבתי זה ההתמקדות במתווך חרדי מסוים כאילו הוא שורש הרע בעולם כולו ואיך מלאו ליבו כביכול, ומעשה שהיה כך הווה בעשרות עותקים ברחבי הארץ שרובם מוכרים לי היטיב:

אברכים שחושבים שהם אנשי-עסקים פותו בידי אנשי-עסקים שחושבים שהם אברכים לקנות דירות פאר בערים שהם מכירים רק מחלונות האוטובוס בדרך למירון, נתניה ובת ים מככבות בכתבה אך זה לאורך כל הארץ בערים אשר אברך ממוצע מכיר את שמותיהם רק מהתרעות פיקוד העורף (או מהנפילות שאחריהן) ומעולם לא ביקר בהן.

אז איך משכנעים אברך כולל חסידי בן 22 שקיבל מההורים חצי מיליון ₪ לצורך יחידת 'סליחה' בביתר, לרכוש פנטהוז בהרצליה בארבע מיליון ₪ ?

מספרים לו שזה מבצע מיוחד שהתגלה רק למתווך בגילוי שמימי וכעת צריך רק לשלם עשרה אחוז שזה ארבע מאות אלף שקל ואת המאה הנותרים להביא למתווך על הגילוי הנפלא.

ואיך הדלפון שלנו יממן את מה שעשירי טבריה מתקשים?

כאן מגיע החלק השני של הגילוי אליהו – המתווך יודע לנבא כי בעוד שלוש שנים, כשיצטרכו להשלים את הרכישה הדירה תהיה שווה חמישה מיליון, ואז האברך דנן יתברר כסוחר מוצלח ביותר אשר ימשוך חזרה את הארבע מאות ועוד מיליון רווח נקי וכך לא יצטרך לגור בדירת הסליחה אלא בדירה גדולה המרחיבה דעתו של אדם ומרחיבה ארנקו של המשווק.

אז איפה הקצ'?

שעכשיו זה "אחרי שלוש שנים" ומתברר כי המחיר הכי גבוה שאפשר לקבל על הדירה הוא שלוש וחצי מיליון ואחרי ההוצאות מגיעים לשלוש מאתיים נטו ביד, מה שאומר שלפעמים עדיף לאותו אברך לעשות "ויברח" ולהותיר את הארבע מאות אצל החברה והמשווק ולחזור ליחידת הסליחה אבל וחפוי ראש, והפעם כשוכר...

זה פחות או יותר המסלול שאותו עוברות בחודשים אלו מאות משפחות מאנ"ש שכל מה שהם רצו זה לחתן את הילדים בכבוד וכעת הם מרוסקים לחלוטין וייקח להם שנים רבות אם בכלל כדי להתאושש מהתהום הכלכלית שהם הוכנסו אליה בידי משווק פלוני.

אך עשרת הקוראים כאן יודעים שעד כאן הייתה רק ההקדמה, כעת נתחיל עם הניתוח הכואב של הנתונים ואת הצד של לימוד זכות:

ובכן, קודם כל צריך לדעת שרבים מאוד הרוויחו בפריסיילים ותכניות דומות הרבה כסף, פגשתי ועודני פוגש כל יום אברכים צעירים ומבוגרים שהרוויחו סכומים אגדיים בשנים האחרונות כתוצאה מהפטנט הזה, לא ערכתי מחקר עומק אך מהתרשמותי המרוויחים רבים בהרבה על המפסידים וחבל שאת זה שומרים בסוד מאימת המצ'ינגים, הסיבה היחידה שמספרים לי על כך זה או כדי לשאול איך לעשות את הסיבוב הבא או כדי להתייעץ איך לצמצם את המסים העצומים (ברוך השם, כשיש מס סימן שיש שבח).

כל מי שקנה דירה בירושלים במחירי פריסייל של עשרים ומשהו אלף עשה את המיליון הזה, כך גם רבים שהשקיעו בחלק מהפרוייקטים בבן שמן וכך גם במקומות נוספים אשר המחירים עלו שם דרמטית ולקחו איתם את המשקיעים כלפי מעלה.

אז מה קרה בכל הפרוייקטים הכושלים?

שני דברים, הראשון שלא ידוע לי אם קרה זה הקפצת מחירים, מאוד ייתכן שמשווק מסוים יבוא לקבלן שיש לו כבר פריסייל ויגיד לו במקום למכור ב3.9 אביא לך קונים בארבע מיליון ואז מקבלים תרי זוזי: מאה אלף מהקבלן ועוד אחד מהלקוח, חד גדיא דזבין את אבא.

זה נורא לשמוע שיש דברים כאלו וטיפש מי שנופל לכך אך מי שיותר טיפש ממנו הוא מי שמאמין שאפשר למנוע דבר כזה באמצעות בירור אם המתווך אמין: גם המתווך האמין ביותר לא יעמוד בפני ניסיון של מאתיים אלף ₪ רק מלאך יוותר על זה ולא ניתנה תורת העסקים למלאכי השרת.

אך הדבר הזה לא מתקיים בדרך כלל משום שרוב הקונים יודעים לבדוק בערך את המחיר בסביבה ולא נופלים לבורות עמוקים, מה שכן קורה זה הדבר השני ועליו ברצוננו לדבר:

המחיר פשוט לא עלה, ולפעמים אפילו ירד.

כן רבייסיי, מחירי דירות לא רק עולים, לפעמים הם גם יורדים, כגון למשל בתקופת מלחמה.

עד מלחמת שמחת-נורא המחירים בנתניה למשל אכן השתוללו כי הצרפתים קנו שם בהמוניהם והוא הדין בצפת שהאמריקאים עטו עליה כי אצלם אין הבדל בין ירושלים לצפת, באמריקה זה מרחק סביר לנסיעה יומיומית לעבודה, אז מישהו משווק להם את זה כירושלים לעניים והם קנו וקנו והמחירים עלו ועלו והייתה היתכנות מסויימת לעלייה צפוייה.

ואז הגיע המלחמה ואין חוצניקים, ועוד מלחמה ועוד מבצע ושום דבר לא חזר לעצמו ואפשר לקלל את איראן (מגיע להם) ואת החמאס (עוד יותר מגיע) אך זה לא יעזור לעובדה הפשוטה שמחירי המגדלים שיועדו בעיקר לאוכלוסיות אלו צולל.

לא בהרבה, אך מספיקה ירידה של 8% כדי שכל העסק יהפוך להפסד.

זה נכון שמעצבן שהמשווק ניבא שהמחירים יעלו והם לא, אמנם אמרו חז"ל שנבואה ניתנה לשוטים אך האמונה כי יש למישהו נבואה ניתנה לשוטים גדולים עוד יותר... כל בר דעת העושה עסקים יודע שבכל הקשור לניבוי עתידות - המשווק ועטיפת המסטיק יודעים לנבא באותה מידה ומי שמסתמך על הבטחות אודות העתיד (כולל אלפי אברכים שנופלים היום בפריסייל של המחר שנקרא פינוי בינוי המבוסס על אותה נבואה כמעט) אין לו לבוא בטענות אלא על עצמו, לא המשווק נשך לשונרא.

מקווה שהצלחתי להסביר: לא כל עסקה כושלת היא נוכלות ולא כל ירידת מחירים היא עקיצה, בכל עסק ייתכן מאוד הפסד ומי שלא מוכן לכך שלא ייכנס לעולם ההשקעות.

אז להפסיק להשקיע בנדל"ן?

חלילה, כמה שיותר להשקיע בנדל"ן וכל המרבה הרי זה משובח – ואם ירצה השם ויהיה זמן נרחיב אולי בטור הבא על "מה כן" – אך רק עסקאות נטולות הימור על כל הקופה, כך שגם אם נגזר עליך להפסיד זה יהיה רק קצת ורק זמני.

ברור לי שכל הדברים האמורים כאן ברורים לכל אחד מעשרת הקוראים וסליחה שבזבזתי את זמנכם אך אם זה ירגיע אבא סוער אחד -שכועס בכל ליבו על המתווך שכאילו הפיל את החתן שלו - והיה זה שכרי.



גילוי נאות: לכותב אין ולא היה שום אינטרס כלכלי בשום פרוייקט של פריסל והוא אינו קשור היום לשום שיווק לא במישרין ולא בעקיפין, המידע מובא ללא כל אינטרס כלכלי אלא כצדקה ושירות לציבור, לשאלות ספציפיות ניתן לפנות למייל והתשובות שם חינם וללא אחריות.
סיכום אירועים: איראן בלהבות - מהמחאות ועד לסף עימות עולמי

הרקע וההתפרצות (סוף דצמבר 2025):

המחאות החלו ב-28 בדצמבר 2025 בטהראן, על רקע משבר כלכלי חריף וצניחה חדה בערך הריאל. מה שהחל כזעקת סוחרים ואזרחים על יוקר המחיה, הפך במהירות לגל הפגנות חסר תקדים ב-187 ערים הקורא להפלת המשטר.


הטבח והחשכת המידע (ינואר 2026):
  • דיכוי אלים: המשטר האיראני הגיב באכזריות יוצאת דופן. לפי נתוני ארגון זכויות האדם HRANA, נכון ל-23 בינואר, מספר ההרוגים המאומת עומד על למעלה מ-5,000 בני אדם, בהם 4,716 מפגינים ועשרות ילדים.
    יש דיווחים לא מאומתים מצד האופוזיציה האיראנית על מעל 60,000 הרוגים!

  • מעצרים המוניים: למעלה מ-26,500 בני אדם נעצרו, וקיים חשש כבד להוצאות להורג המוניות בבתי הכלא.

  • חסימת אינטרנט: החל מה-8 בינואר הוטל מצור דיגיטלי כמעט מוחלט על המדינה כדי למנוע זליגת תיעודים מהטבח.

המעורבות האמריקנית - "הארמדה של טראמפ":
הנשיא טראמפ, שחזר והזהיר את טהראן מפני המשך הטבח, הכריז ב-22 בינואר כי "ארמדה" אמריקנית (צי ספינות מלחמה, כולל נושאת המטוסים אברהם לינקולן) עושה את דרכה למפרץ הפרסי. טראמפ הבהיר כי ארה"ב בוחנת אפשרויות תקיפה ישירות נגד מטרות שלטוניות אם לא ייפסק הדיכוי. ולאחר הדלפות על ממדי הטבח, הכריז "העזרה בדרך".


הזווית הישראלית והאזורית:
  • כוננות שיא: ישראל נמצאת בדריכות עליונה מחשש שהסלמה אמריקנית תוביל לתגובה איראנית ישירה או באמצעות שלוחיה (פרוקסי).

  • איומי נתניהו: ראש הממשלה נתניהו הזהיר כי אם איראן תבצע "טעות" ותתקוף את ישראל, היא תפגוש עוצמה שטרם הכירה.

  • איומי טהראן: המשטר האיראני הודיע כי במקרה של תקיפה, בסיסים אמריקניים ויעדים בישראל יהיו "מטרות לגיטימיות".

באשכול זה נמשיך לעדכן סביב השעון בכל התפתחות, דיווחים מהשטח ופרשנויות ביטחוניות.
עודכן אדר תשפ"ד
ראשית, גופי הכשרות
ברוב אשכולות בנושא 'השקעות בשוק ההון' בפרוג, משתרבב עניין הכשרות.
למען הסדר באשכול זה נעלה עדכונים בנושא כשרות.
אני אשתדל לסכם ולתמצת ככל האפשר.

יש 4 גופי כשרות
  • בד"ץ העדה החרדית - על פי פסקי הרב יעקב בלוי זצ"ל שהיה בקיא גדול בתחום שוק ההון והוא שהביא את פסקיו ועל פי פסקים אלו נוהגים עד היום בגוף כשרות זה. היום הכשרות בראשות הרב שלמה זאב קרליבך.
  • גלאט הון - על פי פסקי רבי ניסים קרליץ והרב שמואל ואזנר. שסמכו ידיהם על הרב יעקב לנדו שמכיר את שוק ההון לעומקו. הרב משה שטרנבוך ראב"ד העדה החרדית הוא מרבני 'גלאט הון'.
  • תשואה כהלכה – הרב שמואל דוד גרוס, רב חסידי גור אשדוד ועוד רבנים מוכרים וידועים בכל שכבות הציבור החרדי.
  • כלכלה על פי ההלכה- הרב אריה דביר, על פי פסקי הרב יוסף שלום אלישיב.

היום בכל החברות יש מסלולים כשרים, שמאושרים לפחות ע"י אחת מהכשרויות.
בין החברות שנמצאת ברשותם תעודת כשרות אפשר למצוא את:
אלטשולר שחם, אינפיניטי, הפניקס, הראל, כלל, מגדל, מור, מיטב דש, מנורה.

רשימות קרנות כשרות:

אשכולות דומים

לאחר עבודה סזיפית מתישה, הוצאתי לאור תוכנה שמציגה ומפיקה נתוני זמני היום.
התוכנה מייצרת כ-80 עמודות באקסל (שזה המון המון) כ-41 עמודות של זמנים, 11 עמודות של לימוד יומי,
פרשות השבוע והפטרות לאשכנזים, ספרדים ותימנים עם המקורות שלהם, המולד לכל חודש, ועוד.
התוכנה פשוטה מאוד לשימוש וקלה להפעלה.
הנתונים מותאמים ומכויילים ללוח עתים לבינה (אם כי פה ושם יתכנו הפרשים של כדקה)
כרגע התוכנה מכסה את רוב הערים המרכזיות בארץ (92 אופקים)
התוכנה מאפשרת לשנות את הערכים של הערים וכן להוסיף ערים חדשות לרשימה (רק למי שיודע מה הוא עושה)

התוכנה הלא רשומה מאפשרת:
א. צפייה בכל הזמנים.
ב. הפקת לוח ה'תשפ"ו במלואו לאקסל לכל אופק.
ג. שינוי ערכי הערים.

התוכנה הרשומה מאפשרת:
א. ייצוא לאקסל לכל השנים.
ב. הפקות שונות ל-PDF
ג. משיכת נתונים מהאתר 2NET (זאת לאחר אישור כתוב מהנהלת 2NET) והפקת הנתונים כקובץ CSV


פונקציות לעתיד:
א. קלוח מפיק קובץ CSV אבל תמיד לפי השנה הלועזית, היינו 01/01/2XXX עד ל-31/12/2XXX.
חשבתי להוסיף פונקציה שבו המשתמש מפיק מקלוח 3 שנים היינו ואת התוכנה קוראת את הקבצים ומסדרת את הנתונים מ-א תשרי ועד כט אלול לשנה הרצויה.

ב. עיצוב לוח שנה.
המעצב מכין רק את הרקע ללוח שנה, ואז בתוכנה הוא ממקם את הפרטים ואז התוכנה מייצאת ל-PDF לוח שנה מוכן.

ג. אולי שעון מעורר לפי זמני היום כמו שעה וחצי לפני סוף זמן קריאת שמע וכו'.

ד. פתוח לרעיונות שלכם.

בינתיים, התוכנה זמינה להורדה באתר של פונטייפ תחת הלשונית "תוכנת קל זמן"

אשמח לשמוע את דעתכם על התוכנה.
KZSCR.jpg

הצטרפות לניוזלטר

איזה כיף שהצטרפתם לניוזלטר שלנו!

מעכשיו, תהיו הראשונים לקבל את כל העדכונים, החדשות, ההפתעות בלעדיות, והתכנים הכי חמים שלנו בפרוג!

לוח מודעות

הפרק היומי

הפרק היומי! כל ערב פרק תהילים חדש. הצטרפו אלינו לקריאת תהילים משותפת!


תהילים פרק כה

אלְדָוִד אֵלֶיךָ יי נַפְשִׁי אֶשָּׂא:באֱלֹהַי בְּךָ בָטַחְתִּי אַל אֵבוֹשָׁה אַל יַעַלְצוּ אֹיְבַי לִי:גגַּם כָּל קוֶֹיךָ לֹא יֵבֹשׁוּ יֵבֹשׁוּ הַבּוֹגְדִים רֵיקָם:דדְּרָכֶיךָ יי הוֹדִיעֵנִי אֹרְחוֹתֶיךָ לַמְּדֵנִי:ההַדְרִיכֵנִי בַאֲמִתֶּךָ וְלַמְּדֵנִי כִּי אַתָּה אֱלֹהֵי יִשְׁעִי אוֹתְךָ קִוִּיתִי כָּל הַיּוֹם:וזְכֹר רַחֲמֶיךָ יי וַחֲסָדֶיךָ כִּי מֵעוֹלָם הֵמָּה:זחַטֹּאות נְעוּרַי וּפְשָׁעַי אַל תִּזְכֹּר כְּחַסְדְּךָ זְכָר לִי אַתָּה לְמַעַן טוּבְךָ יי:חטוֹב וְיָשָׁר יי עַל כֵּן יוֹרֶה חַטָּאִים בַּדָּרֶךְ:טיַדְרֵךְ עֲנָוִים בַּמִּשְׁפָּט וִילַמֵּד עֲנָוִים דַּרְכּוֹ:יכָּל אָרְחוֹת יי חֶסֶד וֶאֱמֶת לְנֹצְרֵי בְרִיתוֹ וְעֵדֹתָיו:יאלְמַעַן שִׁמְךָ יי וְסָלַחְתָּ לַעֲוֹנִי כִּי רַב הוּא:יבמִי זֶה הָאִישׁ יְרֵא יי יוֹרֶנּוּ בְּדֶרֶךְ יִבְחָר:יגנַפְשׁוֹ בְּטוֹב תָּלִין וְזַרְעוֹ יִירַשׁ אָרֶץ:ידסוֹד יי לִירֵאָיו וּבְרִיתוֹ לְהוֹדִיעָם:טועֵינַי תָּמִיד אֶל יי כִּי הוּא יוֹצִיא מֵרֶשֶׁת רַגְלָי:טזפְּנֵה אֵלַי וְחָנֵּנִי כִּי יָחִיד וְעָנִי אָנִי:יזצָרוֹת לְבָבִי הִרְחִיבוּ מִמְּצוּקוֹתַי הוֹצִיאֵנִי:יחרְאֵה עָנְיִי וַעֲמָלִי וְשָׂא לְכָל חַטֹּאותָי:יטרְאֵה אוֹיְבַי כִּי רָבּוּ וְשִׂנְאַת חָמָס שְׂנֵאוּנִי:כשָׁמְרָה נַפְשִׁי וְהַצִּילֵנִי אַל אֵבוֹשׁ כִּי חָסִיתִי בָךְ:כאתֹּם וָיֹשֶׁר יִצְּרוּנִי כִּי קִוִּיתִיךָ:כבפְּדֵה אֱלֹהִים אֶת יִשְׂרָאֵל מִכֹּל צָרוֹתָיו:
נקרא  2  פעמים
למעלה