AutoMaps (sheet1)

' (C) https://www.reddit.com/user/danger355
' This work is licensed under a Creative Commons Attribution 4.0 International License

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Check if Custom Property(ies) exist, add to worksheet properties if no
On Error Resume Next
ActiveWorkbook.CustomDocumentProperties.Add Name:="Location elev.", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=10
ActiveWorkbook.CustomDocumentProperties.Add Name:="Vicinity elev.", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=16
ActiveWorkbook.CustomDocumentProperties.Add Name:="Images needed", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=2
ActiveWorkbook.CustomDocumentProperties.Add Name:="First check", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0
ActiveWorkbook.CustomDocumentProperties.Add Name:="Image 1 Name", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="Location"
ActiveWorkbook.CustomDocumentProperties.Add Name:="Image 2 Name", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="Vicinity"
ActiveWorkbook.CustomDocumentProperties.Add Name:="Image 1 Width", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=600
ActiveWorkbook.CustomDocumentProperties.Add Name:="Image 1 Height", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=480
ActiveWorkbook.CustomDocumentProperties.Add Name:="Image 2 Width", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=600
ActiveWorkbook.CustomDocumentProperties.Add Name:="Image 2 Height", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=480
bolExistsLocElev = (Err = 0)
On Error GoTo 0

'Notification of named cells requirement (only run once)
If ActiveWorkbook.CustomDocumentProperties("First check").Value = 0 Then
    ActiveCell.Offset(0, 1).Select
    MsgBox ("This spreadsheet has macros that" & vbNewLine _
    & "require the use of named cells to" & vbNewLine _
    & "automatically generate map images." & vbNewLine _
    & vbNewLine _
    & "Please name the appropriate cells:" & vbNewLine _
    & vbNewLine _
    & "   " & Chr(34) & "starter" & Chr(34) & "  " & Chr(34) & "lat" & Chr(34) & "  " & Chr(38) & "  " & Chr(34) & "long" & Chr(34) & vbNewLine _
    & vbNewLine _
    & " (verbatim & case sensitive)"), , "First Run"
    ActiveWorkbook.CustomDocumentProperties("First check").Value = 1
Exit Sub
End If

'Make sure only 1 or 2 images are needed in Custom Property
If ActiveWorkbook.CustomDocumentProperties("Images needed").Value > 2 Then
    MsgBox "Images Needed quantity in " & vbNewLine & "Custom Properties must be " & vbNewLine & Chr(34) & "1" & Chr(34) & " or " & Chr(34) & "2" & Chr(34) & "only.", , "Oops..."
    ActiveCell.Offset(0, 1).Select
Exit Sub
End If

'Check if Starter Cell exists
On Error Resume Next
Set rCellCheck = Nothing
Set rCellCheck = Range("starter")
On Error GoTo 0
If Not rCellCheck Is Nothing Then
'If Starter Cell does exist, and it's double-clicked...
If Target.Address = Range("starter").Address Then
'If the cell for Latitude is invalid (no Latitude), then the program will not run
'Instead, an error message will be displayed

'Check if Lat and Long Cells exist, exit if not
    On Error Resume Next
    Set rCellCheck = Nothing
    Set rCellCheck = Range("lat")
    On Error GoTo 0
    If rCellCheck Is Nothing Then
        ActiveCell.Offset(0, 1).Select
        MsgBox ("named cell " & Chr(34) & "lat" & Chr(34) & " does not exist."), , "Oops..."
        Exit Sub
    End If

    On Error Resume Next
    Set rCellCheck = Nothing
    Set rCellCheck = Range("long")
    On Error GoTo 0
    If rCellCheck Is Nothing Then
        ActiveCell.Offset(0, 1).Select
        MsgBox ("named cell " & Chr(34) & "long" & Chr(34) & " does not exist."), , "Oops..."
        Exit Sub
    End If

'Check if Lat and Long Cells have error
    If IsNumeric(Range("lat")) = False Or IsNumeric(Range("long")) = False Then
        ActiveCell.Offset(0, 1).Select
        MsgBox ("GPS Coordinates not found." & vbNewLine _
        & vbNewLine _
        & "(Wrong FA Code?)"), , "Oops..."
        Exit Sub
    End If
'Always centers the dialogue box on the open spreadsheet
    With UserForm1
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
        .LocationBox.Caption = ActiveWorkbook.CustomDocumentProperties("Image 1 Name").Value & " Map"
        .VicinityBox.Caption = ActiveWorkbook.CustomDocumentProperties("Image 2 Name").Value & " Map"
        .Show
    End With
    ActiveCell.Offset(0, 1).Select
End If
End If
End Sub