Hallo zusammen,

ich habe ein Problem mit einem Skript, das den User nach Geburtszeitpunkt und -ort fragt, und auf Basis dessen den Aszendenten berechnet.

Ich benutze VBA in Excel 365 für Mac.

Das Skript läuft sauber durch, aber der Aszendent wird am Ende nicht ausgegeben.

Besten Dank im voraus und beste Grüße,

                                                                         Alfred

Option Explicit

Sub CalculateAscendant()
    Dim birthDate As Date
    Dim birthTime As Date
    Dim birthPlace As String
    Dim birthLat As Double
    Dim birthLong As Double
    Dim asc As Double
    
    ' Prompt user for birth date and time
    birthDate = InputBox("Enter your birth date (MM/DD/YYYY):")
    birthTime = InputBox("Enter your birth time (HH:MM AM/PM):")
    
    ' Prompt user for birth location
    birthPlace = InputBox("Enter your birth place (City, State, Country):")
    
    ' Use AppleScript to get latitude and longitude for birth location
    birthLat = GetLatitude(birthPlace)
    birthLong = GetLongitude(birthPlace)
    
    ' Calculate Ascendant using Placidus house system
    asc = CalculatePlacidusAscendant(birthDate, birthTime, birthLat, birthLong)
    
    MsgBox "Your Ascendant is " & FormatDegree(asc)
End Sub

Function GetLatitude(place As String) As Double
    Dim latScript As String
    Dim latResult As Variant
    Dim lat As Double
    
    ' Build AppleScript to get latitude for birth location
    latScript = "set placeName to """ & place & """ as text" & vbNewLine
    latScript = latScript & "tell application ""Maps""" & vbNewLine
    latScript = latScript & "set thePlace to first item of (search the current map for placeName)" & vbNewLine
    latScript = latScript & "set theLat to latitude of thePlace" & vbNewLine
    latScript = latScript & "end tell" & vbNewLine
    latScript = latScript & "return theLat"
    
    ' Run AppleScript to get latitude for birth location
    latResult = Evaluate("APPLESCRIPT(" & Chr(34) & latScript & Chr(34) & ")")
    lat = CDbl(latResult)
    GetLatitude = lat
End Function
Function GetLongitude(place As String) As Double
    Dim longScript As String
    Dim longResult As Variant
    Dim lang As Double
    
    longScript = "set myAddress to """ & place & """" & vbNewLine & _
                 "tell application ""Maps""" & vbNewLine & _
                 "    set myLocation to get location of first item of (get every result whose name contains myAddress)" & vbNewLine & _
                 "    return longitude of myLocation" & vbNewLine & _
                 "end tell"
    
    longResult = Run("osascript -e " & Chr(34) & longScript & Chr(34))
    
    If IsNumeric(longResult) Then
        lang = CDbl(longResult)
    Else
        lang = 0
    End If
    
    GetLongitude = lang
End Function
Function CalculatePlacidusAscendant(birthDate As Date, birthTime As Date, birthLat As Double, birthLong As Double) As Double
    Dim birthDateTime As Double
    Dim jd As Double
    Dim t As Double
    Dim obliq As Double
    Dim lst As Double
    Dim e As Double
    Dim d As Double
    Dim oblCor As Double
    Dim ascmc(10) As Double
    Dim armc As Double
    Dim eps As Double
    Dim sid As Double
    Dim i As Integer
    
    ' Convert birth date and time to Julian Date
    birthDateTime = CDbl(birthDate + TimeSerial(Hour(birthTime), minute(birthTime), second(birthTime)))
    jd = JulianDate(birthDateTime)
    
    ' Calculate T (number of Julian centuries since J2000.0)
    t = (jd - 2451545) / 36525
    
    ' Calculate obliquity of the ecliptic
    obliq = Obliquity(t)
    
    ' Calculate local sidereal time
    lst = LocalSiderealTime(birthLong, jd)
    

    ' Calculate ecliptic position of Ascendant
    e = obliq + (0.00256 * Cos(Radians(125.04 - (1934.136 * t))))
    d = -1 * (0.00017 * Sin(Radians(125.04 - (1934.136 * t))))
    oblCor = obliq + e + d
    ascmc(0) = 0
    CalculatePlacidusAscendant = ascmc(1)
    
    For i = 1 To 10
    
        ascmc(i) = EclipticPosition(jd, (i - 1) * 30, birthLat, birthLong, lst, oblCor)
    Next i
End Function
Function FormatDegree(angle As Double) As String
    Dim degree As Integer
    Dim minute As Integer
    Dim second As Double
    
    degree = Int(angle)
    minute = Int((angle - degree) * 60)
    second = ((angle - degree - minute / 60) * 3600)
    
    FormatDegree = Format(degree, "00") & "°" & Format(minute, "00") & "'" & Format(second, "00.00") & """"
End Function