Thema Datum  Von Nutzer Rating
Antwort
Rot Astro: Aszendent berechnen
10.05.2023 14:53:17 Alfred
****
NotSolved
11.05.2023 23:13:18 Gast01233
NotSolved
12.05.2023 00:17:51 Alfred
NotSolved
12.05.2023 00:32:55 Gast42581
NotSolved
12.05.2023 01:35:49 Alfred
*****
NotSolved

Ansicht des Beitrags:
Von:
Alfred
Datum:
10.05.2023 14:53:17
Views:
415
Rating: Antwort:
  Ja
Thema:
Astro: Aszendent berechnen

 

 

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

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Astro: Aszendent berechnen
10.05.2023 14:53:17 Alfred
****
NotSolved
11.05.2023 23:13:18 Gast01233
NotSolved
12.05.2023 00:17:51 Alfred
NotSolved
12.05.2023 00:32:55 Gast42581
NotSolved
12.05.2023 01:35:49 Alfred
*****
NotSolved