April 2006

Map Point from Excel

Today I have been I'r'een mostly messing about with Map Point.
The following code (called with the GetDistance sub) will return the distance between 2 post codes. To use this code as is, you'll need to select 2 adjacent cells (i.e. A1 and B1), the distance will be put in the 3rd column along (i.e C1). Clearly you will need Map Point installed also. It's late bound, but I have not tested the error and checking code should Map Point not be on the machine. I have version 2004 of Map Point  and I didn't have much joy in automating pervious version, but give it a try anyway!

VBA:
  1. Option Explicit
  2. Global gObjApp As Object '''Golbal deleration for the Map Point Object
  3. Sub GetDistance()
  4.     Dim cell As Excel.Range
  5.     Dim i As Long
  6.  
  7. If gObjApp Is Nothing Then
  8. OpenMapPointApp
  9. If gObjApp Is Nothing Then ' check app was established ok
  10. Exit Sub
  11. Else: End If
  12. Else: End If
  13.  
  14.     For i = 1 To Selection.Rows.Count
  15.      Selection.Cells(i, 3) = GRD(Selection.Cells(i, 1), Selection.Cells(i, 2))
  16.     Next
  17.  
  18. If gObjApp Is Nothing Then
  19. Else:
  20. CloseMapPointApp
  21. End If
  22. End Sub
  23. Sub OpenMapPointApp()
  24. On Error GoTo LEH
  25.    Set gObjApp = CreateObject("MapPoint.Application")
  26.     gObjApp.Visible = False
  27.     'gObjApp.UserControl = True
  28.     Exit Sub
  29. LEH:
  30. MsgBox "Sorry Could not open a Map Point Application, bummer! - Ross" _
  31. , vbOKOnly + vbCritical, "M.I.E Map Point thing"
  32.  
  33. End Sub
  34. Sub CloseMapPointApp()
  35. '''Change saved property to ture for the the active (and only) map,
  36. '''stops any maessage getting displayed
  37.     gObjApp.ActiveMap.Saved = True
  38.     gObjApp.Quit
  39.     Set gObjApp = Nothing
  40. End Sub
  41. '---------------------------------------------------------------------------------------
  42. ' Function  : GetRouteDistance
  43. ' DateTime  : 18/04/2006 16:04
  44. ' Author    : rmclean
  45. ' Purpose   : Gets the routed distacne between 2 way points using an already opened
  46. '             Map Point Object.
  47. '---------------------------------------------------------------------------------------
  48. Function GRD(sPCFrom As String, sPCTo As String)
  49. On Error GoTo LEH
  50.     With gObjApp.ActiveMap.ActiveRoute
  51.         .Clear
  52.         .Waypoints.Add gObjApp.ActiveMap.FindAddressResults(PostalCode:=sPCFrom, Country:=0)(1)
  53.         .Waypoints.Add gObjApp.ActiveMap.FindAddressResults(PostalCode:=sPCTo, Country:=0)(1)
  54.         .Calculate
  55.         GRD = .Distance
  56.     End With
  57. Exit Function
  58.  
  59. LEH:
  60. '''There could be a few reasons for an erorr, proably could not
  61. '''match the post code, I dont care that much, just need to return
  62. ''' a good anwser.
  63. GRD = "Could Not Route"
  64. End Function

I have used the LocaleID of the user's computer for the country value (...FindAddressResults(PostalCode:=sPCFrom, Country:=0)...) the full list is here: GeoCountry values

bon!

Printing PDF files with VBA

PDF Creator is a super little tool which lets you print out any documents to a .pdf file. Once it's installed all you have to do is select it from the print dialog and it will make you that PDF.

But what if you want to get hold of this functionally in your own code? No problemo! Like many 3rd party tools it has a full COM interface, so you can get hold of it with VBA.

Even better is that my Buddy Ken Plus of ExcelGuru.ca has put toghter a whole lot of information and code of precisely how to do it. Ken's example can be found here:

Late Binding http://www.excelguru.ca/XLVBA/XLVBA12.htm
Early Binding http://www.excelguru.ca/XLVBA/XLVBA14.htm

Thanks Ken!

Pausing Excel

From time to time i like to make Excel pause. A typical example is when a process has finished and I'm about to hide a userform. I may need/want to give some info to the user, for which i need to display the form for a little longer. a simple one line can do the trick.

VBA:
  1. Application.Wait Now + TimeValue("0:00:01")

The lenght of time is controlled by the last part, which is hours, mins, seconds,

You can also use the Application wait to run code at a defined time this would run 5.30 pm

VBA:
  1. Application.Wait "17:30:00"<code>

Bon.

Excel and Windows Dialogs

Excel allows us to get hold of many builtin dialogs via it's object model. For example:

VBA:
  1. Sub OpenDialog()
  2.  
  3. Application.Dialogs(xlDialogOpen).Show
  4.  
  5. End Sub

Shows the open file dialog. More infomation can be found here:

http://support.microsoft.com/?kbid=213371#E6ACAAA

A lot of the time, what Excel is doing is using API layers to get hold of these diologs (i.e. the common dialogs), it then allows us to use them with a few lines of code. But If you can't get the fuctionality you want from the Excel object, you should be able to find an API method. Here's a SaveAs one for example:

http://www.mvps.org/access/api/api0001.htm

Note: you will need to change the line "If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp" to "If IsMissing(hwnd) Then hwnd = Application.hWnd" to get it to work, and some of the filters to get it to function as you like in Excel.

				

Custom File Extensions

Sometime it can be useful to save files with custom file extensions, such as "MyWork.mie". This allows us to filter these files out when we used the OpenFile dialog for example. It also means that we can associate that file extension with a front loader, if we are using one.

It's very simple to save out a file with a custom extension, you just have to specify it during the save operation. I tend to stick with text formats but it is possible to use .xls file formats with custom extensions. For example

VBA:
  1. Function MakeWorkbook()
  2.  
  3. Const FILE_EXTENSION As String = ".MIE"
  4. Dim sFileString As String
  5.  
  6. sFileString = "*" & FILE_EXTENSION
  7. sFileString = "M.I.E data file (" & sFileString & "), " & sFileString
  8. sFileString = Application.GetSaveAsFilename("", FileFilter:=sFileString)  'This gets the full path!
  9. Workbooks.Add
  10. ActiveWorkbook.SaveAs FileName:=sFileString ',FileFormat:=xlCSV   "˜ xlTextMSDOS "˜ some other file formats
  11.  
  12. End Function

Note that the underlining file type does not change.