VBA & Classes - how to fill values?

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,392
Office Version
  1. 365
Platform
  1. Windows
I'm trying to build some geographical classes in VBA. Am rather experienced in VBA, but do get stuck here. What I would like to do is set a geographical box, based on 2 coordinates (e.g. North Eastern point and South Western point). The coordinate-class is set up and works fine (named latLng), but I can't figure out how to set up the latLngBounds class. Can anyone here help me out?
Below are:
  • my VBA test script
  • the working latLng class
  • the trouble maker latLngBounds class
Thanks in advance for some help/advice!

VBA Code:
'TESTSCRIPT:
Sub TestBox()

Dim CoordSW As New latLng
CoordSW.lat = 52.067267
CoordSW.lon = 5.1114603
Dim CoordNE As New latLng
CoordNE.lat = 52.074799
CoordNE.lon = 5.1285214

Debug.Print CoordSW.toString
Debug.Print CoordSW.distanceTo(CoordNE)

Dim TotBox As New latLngBounds '? probably not the right way?
'Set TotBox.latLngBounds(CoordSW,CoordNE) '? same here?

End Sub

The working code for latLng:
VBA Code:
' CLASS MODULE CODE for latLng
' following logic from https://leafletjs.com/reference-1.6.0.html#latlngbounds
' https://excelmacromastery.com/vba-class-modules/
'x = lon - East/West
'y = lat - North/South

' Member variable
Private clat As Double
Private clon As Double

' Properties
Property Get lat() As Double
    lat = clat
End Property
Property Let lat(value As Double)
    clat = value
End Property

Property Get lon() As Double
    lon = clon
End Property

Property Let lon(value As Double)
    clon = value
End Property

' Event - triggered when class created
Private Sub Class_Initialize()
    clat = 0
    clon = 0
End Sub

Public Function toString() As String
    'toString()  String Returns a string representation of the point (for debugging purposes).
    'e.g.  LatLng(51.504789, 5.046692)
    toString = "LatLng(" & Trim(Str(clat)) & "," & Str(clon) & ")"
End Function

Public Function distanceTo(latLngIn As latLng) As Double
    
    'distanceTo(<LatLng> otherLatLng) Number Returns the distance (in meters) to the given LatLng calculated using the Spherical Law of Cosines.
    'http://www.cpearson.com/excel/LatLong.aspx
    Dim Delta As Double
    Dim C_PI As Double
    C_PI = 4 * Atn(1)
    Dim C_RADIUS_EARTH_KM As Double
    C_RADIUS_EARTH_KM = 6370.97327862
    
    ' convert to radians: radians = (degrees/180) * PI
    Dim Lat1 As Double
    Dim Lat2 As Double
    Dim Long1 As Double
    Dim Long2 As Double
    Lat1 = (latLngIn.lat / 180) * C_PI
    Lat2 = (clat / 180) * C_PI
    Long1 = (latLngIn.lon / 180) * C_PI
    Long2 = (clon / 180) * C_PI
    
    Delta = ((2 * ArcSin(Sqr((Sin((Lat1 - Lat2) / 2) ^ 2) + Cos(Lat1) * Cos(Lat2) * (Sin((Long1 - Long2) / 2) ^ 2)))))
    distanceTo = 1000 * C_RADIUS_EARTH_KM * Delta

End Function

Private Function ArcSin(X As Double) As Double
    ' VBA doesn't have an ArcSin function. Improvise.
    ArcSin = Atn(X / Sqr(-X * X + 1))
End Function

And the trouble maker (effort so far):
VBA Code:
' CLASS MODULE CODE for latLngBounds
' following logic from https://leafletjs.com/reference-1.6.0.html#latlngbounds
' https://excelmacromastery.com/vba-class-modules/

' Member variable
Private clatmax As Double
Private clonmax As Double
Private clatmin As Double
Private clonmin As Double

' Properties
Property Set latLngBounds(coord1 As latLng, coord2 As latLng)
    '? Is this the right way? Maybe should be a Let?
    If coord1.lat > coord2.lat Then
        clatmax = coord1.lat
        clatmin = coord2.lat
    Else
        clatmax = coord2.lat
        clatmin = coord1.lat
    End If

    If coord1.lon > coord2.lon Then
        clonmax = coord1.lon
        clonmin = coord2.lon
    Else
        clonmax = coord2.lon
        clonmin = coord1.lon
    End If

End Property

' Event - triggered when class created
Private Sub Class_Initialize()
    clatmin = 0
    clatmax = 0
    clonmin = 0
    clonmax = 0
End Sub

Public Function getCenter() As latLng
    'getCenter() LatLng
    'Returns the center point of the bounds.
    Dim CoordCenter As New latLng
    CoordCenter.lat = (clatmax + clatmin) / 2
    CoordCenter.lon = (clonmax + clonmin) / 2
    getCenter = CoordCenter
End Function
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
try to replace:
VBA Code:
Property Set latLngBounds(coord1 As latLng, coord2 As latLng)
with:
VBA Code:
Public Sub latLngBounds(coord1 As latLng, coord2 As latLng)
 
Upvote 0
Thanks, that does indeed work!
So I'd have to call my class by doing this?
VBA Code:
Dim TotBox As New latLngBounds
Call TotBox.latLngBounds(CoordSW, CoordNE)
Mmm, I was hoping to have an object where I could do something like
Set TotBox.latLngBounds(CoordSW,CoordNE)
Is that possible with another syntax in my class (I'm assuming a Set)?
 
Upvote 0
It is possible, but I wouldn't bother too much - once it works the way you want it - use it. :)
what exactly do you need an object for? TotBox the way you declared it is in general an object.
you can set it in another way but w/o much difference in this case:
VBA Code:
Dim TotBox As latLngBounds
Set TotBox = New latLngBounds
Call TotBox.latLngBounds (CoordSW, CoordNE)
Actually another syntax you can use without CALL is:
VBA Code:
TotBox.latLngBounds CoordSW, CoordNE
 
Upvote 0
Okay, you're right... If it works, don't break it. Thanks for the feedback!
P.S. I like your avatar, cute dog :)
 
Upvote 0

Forum statistics

Threads
1,214,911
Messages
6,122,199
Members
449,072
Latest member
DW Draft

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top