This page will contain useful functions for managing spatial references
'Written by Graham French, NBN Trust September 2008 and is supplied as is, these functions have not been extensively checked. Please check that they are correctly determining the precision for grid references. Send any comments to ku.gro.nbn|atad#ku.gro.nbn|atad
'WORKS IN MICROSOFT ACCESS AND EXCEL
Precision
This function gets the precision of a grid reference returning unidentified if grid reference is invalid
'GETS PRECISION FOR BRITAIN AND IRELAND GRIDREFERENCES
'WORKS IN MICROSOFT ACCESS AND EXCEL
Public Function NBN_Get_Precision(gridreference As Variant) As String
Dim sGridRef As Variant
Dim iPrecision As String
sGridRef = UCase(gridreference)
iPrecision = "Unidentified"
'RULES OUT EMPTY GRID REFERENCES
If Not IsNull(sGridRef) Then
'REMOVE ANY SPACES
sGridRef = Replace(sGridRef, " ", "", 1, , vbTextCompare)
'FIND PRECISION
Select Case Asc(Mid(sGridRef, 2, 1))
Case 65 To 90
'GB PROJECTION
Select Case Len(sGridRef)
Case Is = 4 'HECTAD
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
iPrecision = 10000
End If
Case Is = 5 'TETRAD
Select Case Asc(Right(sGridRef, 1))
Case 65 To 78, 80 To 90
iPrecision = 2000
Case Else
End Select
Case Is = 6 'MONAD
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
iPrecision = 1000
End If
Case Is = 8 '100m
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
iPrecision = 100
End If
Case Is = 10 '10m
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
iPrecision = 10
End If
Case Is = 12 '1m
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
iPrecision = 1
End If
End Select
'IRISH PRECISION
Case 48 To 57
Select Case Len(sGridRef)
Case Is = 3 'HECTAD
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
iPrecision = 10000
End If
Case Is = 4 'TETRAD
Select Case Asc(Right(sGridRef, 1))
Case 65 To 78, 80 To 90
iPrecision = 2000
Case Else
End Select
Case Is = 5 'MONAD
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
iPrecision = 1000
End If
Case Is = 7 '100m
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
iPrecision = 100
End If
Case Is = 9 '10m
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
iPrecision = 10
End If
Case Is = 11 '1m
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
iPrecision = 1
End If
End Select
End Select
End If
NBN_Get_Precision = iPrecision
End Function
'Written by Graham French, NBN Trust September 2008 and is supplied as is, these functions have not been extensively checked. Please check that they are correctly determining the projection for grid references. Send any comments to ku.gro.nbn|atad#ku.gro.nbn|atad
'WORKS IN MICROSOFT ACCESS AND EXCEL
Projection
This function gets the projection of a grid reference returning unidentified if grid reference is invalid
'GETS PROJECTION FOR BRITAIN AND IRELAND GRIDREFERENCES
'WORKS IN MICROSOFT ACCESS AND EXCEL
Public Function NBN_Get_Projection(gridreference As Variant) As String
Dim sGridRef As Variant
Dim sProjection As String
sGridRef = UCase(gridreference)
sProjection = "Unidentified"
'RULES OUT EMPTY GRID REFERENCES
If Not IsNull(sGridRef) Then
'REMOVE ANY SPACES
sGridRef = Replace(sGridRef, " ", "", 1, , vbTextCompare)
'FIND PROJECTION
Select Case Asc(Mid(sGridRef, 2, 1))
Case 65 To 90
'GB PROJECTION
Select Case Len(sGridRef)
Case Is = 4 'HECTAD
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
sProjection = "OSGB"
End If
Case Is = 5 'TETRAD
Select Case Asc(Right(sGridRef, 1))
Case 65 To 78, 80 To 90
sProjection = "OSGB"
Case Else
End Select
Case Is = 6 'MONAD
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
sProjection = "OSGB"
End If
Case Is = 8 '100m
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
sProjection = "OSGB"
End If
Case Is = 10 '10m
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
sProjection = "OSGB"
End If
Case Is = 12 '1m
If IsNumeric(Mid(sGridRef, 3, Len(sGridRef) - 2)) Then
sProjection = "OSGB"
End If
End Select
'IRISH PROJECTION
Case 48 To 57
Select Case Len(sGridRef)
Case Is = 3 'HECTAD
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
sProjection = "OSNI"
End If
Case Is = 4 'TETRAD
Select Case Asc(Right(sGridRef, 1))
Case 65 To 78, 80 To 90
sProjection = "OSNI"
Case Else
End Select
Case Is = 5 'MONAD
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
sProjection = "OSNI"
End If
Case Is = 7 '100m
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
sProjection = "OSNI"
End If
Case Is = 9 '10m
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
sProjection = "OSNI"
End If
Case Is = 11 '1m
If IsNumeric(Mid(sGridRef, 2, Len(sGridRef) - 1)) Then
sProjection = "OSNI"
End If
End Select
End Select
End If
NBN_Get_Projection = sProjection
End Function
'Written by Graham French, NBN Trust September 2008 and is supplied as is, this function has not been extensively checked. Please check that it is correctly determining number of characters in site. Send any comments to ku.gro.nbn|atad#ku.gro.nbn|atad
'WORKS IN MICROSOFT ACCESS AND EXCEL (in ACCESS replace IsEmpty function with IsNull function)
SiteName
This function checks that the sitename is not longer than 80 characters
'CHECKS SITENAME IS NOT LONGER THAN 80 CHARACTERS
Public Function NBN_Check_Length_of_SiteName(sitename As String) As String
Dim sitelength As String
If IsEmpty(sitename) Then
sitelength = "Ok"
Else
If Len(sitename) <= 80 Then
sitelength = "Ok"
Else
sitelength = "Too long (" & Len(sitename) & " characters)"
End If
End if
NBN_Check_Length_of_SiteName = sitelength
End Function
