Update (V1.41 Beta 3) released:
- Full-Version 1.40 installer: http://bit.ly/1BKys2l
- Full-Version 1.40 non-installer: http://bit.ly/1G6bZ4X
- Update 1.41 Beta 3: http://bit.ly/1eU04wZ (Full-Version V1.40 required)
Changelog:
- Added new ship type "Diamondback Scout" (Powerplay).
- Changed ship type "Diamondback" to "Diamondback Explorer" at the personal.mdb (Powerplay).
- Fixed issue with date calculation.
I wanted to add a system when the new system panel didn't pop up by itself, I clicked TRADE panel by mistake while in an UNKNOWN STAR SYSTEM (in db but not previously visited)
Sub GetExploreStatus()
Dim SX As Double, SY As Double, SZ As Double, ZX As Double, ZY As Double, ZZ As Double, SID As Long, ZID As Long, z As Long, SZD As Double, ArDistance(1 To 50000) As Double
Dim ArExTemp As Variant, ArTemp As Variant, ArExploData As Variant, a As Long, zeile As Long, lLZeile As Long, ArStars As Variant, x As Long, ArRegSt As Variant, ArURegSt As Variant
ReDim ArExploData(1 To 100000, 1 To 8)
ArRegSt = Worksheets("DB_Stations").Range("Q2:Q" & AzRegStations + 1)
ArURegSt = Worksheets("DB_Stations_UR").Range("Q2:Q" & AzURegStations + 1)
' Dim t As Double
' t = Timer
' MsgBox Timer - t & " sec", , "Makrolaufzeit"
If ActualStarID <> Worksheets("ExploreData").Cells(2, 1).Value Or JR_Changed = True Then
x = 0
Worksheets("ExploreData").Range("A2:H1000001").ClearContents
Worksheets("Navigation_Sort").Range("S2:S" & AzStars + 1).ClearContents
SID = ActualStarID
SX = Ar_DBStars(SID, 3)
SY = Ar_DBStars(SID, 4)
SZ = Ar_DBStars(SID, 5)
For z = 1 To AzStars
ZID = Ar_DBStars(z, 1) ' Ziel Stern
ZX = Ar_DBStars(ZID, 3)
ZY = Ar_DBStars(ZID, 4)
ZZ = Ar_DBStars(ZID, 5)
ArDistance(z) = Round(Sqr(WorksheetFunction.Power((SX - ZX), 2) + WorksheetFunction.Power((SY - ZY), 2) + WorksheetFunction.Power((SZ - ZZ), 2)) + 0.000001, 2)
If ArDistance(z) <= Jump_Limit Then
x = x + 1
ArExploData(x, 1) = Ar_DBStars(z, 1) ' ID
ArExploData(x, 2) = Ar_DBStars(z, 2) ' Name
ArExploData(x, 3) = Ar_DBStars(z, 8) ' Class
If Val(Ar_DBStars(z, 8)) = 0 Then
ArExploData(x, 4) = "?"
Else
If Ar_DBStarTypes(Ar_DBStars(z, 8), 3) = 0 Then
ArExploData(x, 4) = "NO" ' Scoop
Else
ArExploData(x, 4) = "YES" ' Scoop
End If
End If
ArExploData(x, 5) = WorksheetFunction.CountIf(Worksheets("DB_Stations").Range("Q2:Q" & AzRegStations + 1), Ar_DBStars(z, 1)) + WorksheetFunction.CountIf(Worksheets("DB_Stations_UR").Range("Q2:Q" & AzURegStations + 1), Ar_DBStars(z, 1)) ' #Stations
ArExploData(x, 6) = Val(Ar_DBStars(z, 6)) ' ExploreStatus
ArExploData(x, 7) = ArDistance(z) ' Distance
ArExploData(x, 8) = Ar_DBStars(z, 7) ' Notes
End If
Next z
Worksheets("ExploreData").Range("A2:H" & x + 1) = ArExploData
Worksheets("ExploreData").Activate
ActiveWorkbook.Worksheets("ExploreData").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ExploreData").Sort.SortFields.Add Key:=Range( _
"G2:G100001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ExploreData").Sort
.SetRange Range("A1:H100001")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
AzCarto = Worksheets("Data").Cells(14, 5).Value
Ar_Carto = Worksheets("ExploreData").Range("A2:H" & AzCarto + 1)
End If
End Sub
Dim SX As Double, SY As Double, SZ As Double, ZX As Double, ZY As Double, ZZ As Double, SID As Long, ZID As Long, z As Long, SZD As Double, ArDistance(1 To 50000) As Double
Dim ArExTemp As Variant, ArTemp As Variant, ArExploData As Variant, a As Long, zeile As Long, lLZeile As Long, ArStars As Variant, x As Long, ArRegSt As Variant, ArURegSt As Variant
ReDim ArExploData(1 To 100000, 1 To 8)
ArRegSt = Worksheets("DB_Stations").Range("Q2:Q" & AzRegStations + 1)
ArURegSt = Worksheets("DB_Stations_UR").Range("Q2:Q" & AzURegStations + 1)
' Dim t As Double
' t = Timer
' MsgBox Timer - t & " sec", , "Makrolaufzeit"
If ActualStarID <> Worksheets("ExploreData").Cells(2, 1).Value Or JR_Changed = True Then
x = 0
Worksheets("ExploreData").Range("A2:H1000001").ClearContents
Worksheets("Navigation_Sort").Range("S2:S" & AzStars + 1).ClearContents
SID = ActualStarID
SX = Ar_DBStars(SID, 3)
SY = Ar_DBStars(SID, 4)
SZ = Ar_DBStars(SID, 5)
For z = 1 To AzStars
ZID = Ar_DBStars(z, 1) ' Ziel Stern
ZX = Ar_DBStars(ZID, 3)
ZY = Ar_DBStars(ZID, 4)
ZZ = Ar_DBStars(ZID, 5)
ArDistance(z) = Round(Sqr(WorksheetFunction.Power((SX - ZX), 2) + WorksheetFunction.Power((SY - ZY), 2) + WorksheetFunction.Power((SZ - ZZ), 2)) + 0.000001, 2)
If ArDistance(z) <= Jump_Limit Then
x = x + 1
ArExploData(x, 1) = Ar_DBStars(z, 1) ' ID
ArExploData(x, 2) = Ar_DBStars(z, 2) ' Name
ArExploData(x, 3) = Ar_DBStars(z, 8) ' Class
If Val(Ar_DBStars(z, 8)) = 0 Then
ArExploData(x, 4) = "?"
Else
If Ar_DBStarTypes(Ar_DBStars(z, 8), 3) = 0 Then
ArExploData(x, 4) = "NO" ' Scoop
Else
ArExploData(x, 4) = "YES" ' Scoop
End If
End If
ArExploData(x, 5) = WorksheetFunction.CountIf(Worksheets("DB_Stations").Range("Q2:Q" & AzRegStations + 1), Ar_DBStars(z, 1)) + WorksheetFunction.CountIf(Worksheets("DB_Stations_UR").Range("Q2:Q" & AzURegStations + 1), Ar_DBStars(z, 1)) ' #Stations
ArExploData(x, 6) = Val(Ar_DBStars(z, 6)) ' ExploreStatus
ArExploData(x, 7) = ArDistance(z) ' Distance
ArExploData(x, 8) = Ar_DBStars(z, 7) ' Notes
End If
Next z
Worksheets("ExploreData").Range("A2:H" & x + 1) = ArExploData
Worksheets("ExploreData").Activate
ActiveWorkbook.Worksheets("ExploreData").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ExploreData").Sort.SortFields.Add Key:=Range( _
"G2:G100001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ExploreData").Sort
.SetRange Range("A1:H100001")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
AzCarto = Worksheets("Data").Cells(14, 5).Value
Ar_Carto = Worksheets("ExploreData").Range("A2:H" & AzCarto + 1)
End If
End Sub