Load Google Street View images into userform

I

Imabus

New Member
Joined
Mar 4, 2013
Messages
32
Hello All,

I recently found this code, which is to say the least, awesome!

Code: 
Sub GoogleStaticStreetView(oShape As Shape, _                        sAddress As String, _
                        lHeading As Long, _
                        Optional lHeight As Long = 512, _
                        Optional lWidth As Long = 512)


    'https://developers.google.com/maps/documentation/streetview/


    Dim sURL As String
    Dim sMapsURL As String
    Dim bRunMode As Boolean
    On Error GoTo RETURN_FALSE


    If bRunMode Then On Error Resume Next 'Error if quota exceeded


    If Len(sAddress) > 0 Then
        'URL-Escaped addresses
        sAddress = Replace(sAddress, " ", "+")
    Else
        Exit Sub
    End If


    sURL = _
    "http://maps.googleapis.com/maps/api/streetview?" & _
    "&location=" & sAddress & _
    "&size=" & lWidth & "x" & lHeight & _
    "&heading=" & lHeading & _
    "&sensor=false"


    sMapsURL = "http://maps.google.com/maps?q=" & _
    sAddress & "&t=m&layer=c&panoid=0" & _
    "&cbp=12," & lHeading & ",,0,4.18"


    oShape.Fill.UserPicture sURL
    oShape.AlternativeText = sMapsURL


    Exit Sub
RETURN_FALSE:


End Sub


Sub GoogleStaticMap(oShape As Shape, _
                    sAddress As String, _
                    Optional sMapType As String = "roadmap", _
                    Optional lZoom As Long = 12, _
                    Optional lHeight As Long = 512, _
                    Optional lWidth As Long = 512)


    'https://developers.google.com/maps/documentation/staticmaps/


    Dim sURL As String
    Dim sMapsURL As String
    Dim sMapTypeURL As String


    On Error GoTo RETURN_FALSE


    ' Google Maps Parameters '&t=m' = roadmap, '&t=k' = satellite
    sMapTypeURL = "m"
    If sMapType = "satellite" Then
        sMapTypeURL = "k"
    End If


    If bRunMode Then On Error Resume Next 'Error if quota exceeded


    If Len(sAddress) > 0 Then
        'URL-Escaped addresses
        sAddress = Replace(sAddress, " ", "+")
    Else
        Exit Sub
    End If


    sURL = _
    "http://maps.googleapis.com/maps/api/staticmap?center=" & _
    sAddress & "," & _
    "&maptype=" & sMapType & _
    "&markers=color:green%7Clabel:%7C" & sAddress & _
    "&zoom=" & lZoom & _
    "&size=" & lWidth & "x" & lHeight & _
    "&sensor=false" & _
    "&scale=1"


    sMapsURL = "http://maps.google.com/maps?q=" & _
    sAddress & _
    "&z=" & lZoom & _
    "&t=" & sMapTypeURL


    oShape.Fill.UserPicture sURL
    oShape.AlternativeText = sMapsURL


    Exit Sub


RETURN_FALSE:


End Sub




Sub Streetview()
    GoogleStaticStreetView Sheets(1).Shapes.AddShape(msoShapeRectangle, 0, 0, 512, 512), "[COLOR=#7D2727][FONT=Consolas]GooglePlex, CA 94043[/FONT][/COLOR]", 100
    Debug.Assert False
    Sheets(1).Shapes.Delete
End Sub

What i desire is to call this code from one of my userforms that holds 4 images and show 4 views (90 degree differences) of the location.

but i cant find the right syntax to amend this line

Code: 
GoogleStaticStreetView Sheets(1).Shapes.AddShape(msoShapeRectangle, 0, 0, 512, 512), "[COLOR=#7D2727][FONT=Consolas]GooglePlex, CA 94043[/FONT][/COLOR]", 100

to do what i am looking for, i have tried multiple versions of

Code: 
me.streetview1 = GoogleStaticStreetView  (CRM_Main.CustName.Text & " " & CRM_Main.CustAddr.Text & " " & CRM_Main.CustPost.Text, 90)
me.streetview2 = GoogleStaticStreetView  (CRM_Main.CustName.Text & " " & CRM_Main.CustAddr.Text & " " & CRM_Main.CustPost.Text, 180)
me.streetview3 = GoogleStaticStreetView  (CRM_Main.CustName.Text & " " & CRM_Main.CustAddr.Text & " " & CRM_Main.CustPost.Text, 270)
me.streetview4 = GoogleStaticStreetView  (CRM_Main.CustName.Text & " " & CRM_Main.CustAddr.Text & " " & CRM_Main.CustPost.Text, 360)

and editing the called sub to

Code: 
Sub GoogleStaticStreetView(sAddress As String, _
                        lHeading As Long, _
                        Optional lHeight As Long = 512, _
                        Optional lWidth As Long = 512)
.......


but i just don't understand how the image is being handled, and how to get it into my userform images, can anyone help?

Thankyou!

EDIT: Source http://stackoverflow.com/questions/33573556/embed-a-google-street-view-image-into-excel
 
Last edited:
Sort by date Sort by votes
I realise i didn't explain what the code i included does ...

The code looks up an address from the google maps API and inserts the image into a shape in the activesheet.

There is the second sub which returns the map view.
 
Upvote 0
Imabus said:
What i desire is to call this code from one of my userforms that holds 4 images and show 4 views (90 degree differences) of the location.

but i just don't understand how the image is being handled, and how to get it into my userform images, can anyone help?
Click to expand...
Change the 'As Shape' argument to 'As Image', and pass your userform image instead of the shape. Within the procedure, download the Street View image to a temporary file and load it into the image.Picture property using LoadPicture.

Code: 
Option Explicit

#If Win64 Then '64-bit Office
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        (ByRef pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByRef lpfnCB As LongPtr) As LongPtr
#Else '32-bit Office
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If

Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
  
Private Const BINDF_GETNEWESTVERSION As Long = &H10


Public Sub GoogleStaticStreetView(imageControl As Image, _
                                  ByVal sAddress As String, _
                                  lHeading As Long, _
                                  Optional lHeight As Long = 512, _
                                  Optional lWidth As Long = 512)

    'https://developers.google.com/maps/documentation/streetview/

    Dim sURL As String
    Dim sMapsURL As String
    Dim tempImageFile As String
    Static FSO As Object
    Const FSO_TemporaryFolder = 2
    
    sAddress = Replace(sAddress, " ", "+")

    sURL = "http://maps.googleapis.com/maps/api/streetview?" & _
           "&location=" & sAddress & _
           "&size=" & lWidth & "x" & lHeight & _
           "&heading=" & lHeading & _
           "&sensor=false"

    'Not used
    'sMapsURL = "http://maps.google.com/maps?q=" & _
    '           sAddress & "&t=m&layer=c&panoid=0" & _
    '           "&cbp=12," & lHeading & ",,0,4.18"
     
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    tempImageFile = FSO.GetSpecialFolder(FSO_TemporaryFolder) & "\" & Replace(FSO.GetTempName, ".tmp", ".jpg")
    
    If DownloadFile(sURL, tempImageFile) Then
        imageControl.Picture = LoadPicture(tempImageFile)
        Kill tempImageFile
    Else
        MsgBox "Error downloading " & sURL
    End If
    
End Sub


Private Function DownloadFile(URL As String, LocalFileName As String) As Boolean
    
    Dim retVal As Long
    
    DeleteUrlCacheEntry URL
    retVal = URLDownloadToFile(0, URL, LocalFileName, BINDF_GETNEWESTVERSION, 0)
    DownloadFile = (retVal = 0)

End Function
And load into the 4 userform images using:
Code: 
Private Sub UserForm_Initialize()
    GoogleStaticStreetView Me.Image1, "GooglePlex, CA 94043", 90
    GoogleStaticStreetView Me.Image2, "GooglePlex, CA 94043", 180
    GoogleStaticStreetView Me.Image3, "GooglePlex, CA 94043", 270
    GoogleStaticStreetView Me.Image4, "GooglePlex, CA 94043", 360
End Sub
 
Upvote 0
Maybe this is a dumb question.
I am using Excel 2010 64 bit on a W10 machine and i am trying to run this code.
When i get to the Private Function Download, the URLDownloadtoFile gets highlighted and tells me Compile Error: Type Mismatch.
Any idea how i can resolve? thanks.
 
Upvote 0
To fix the compile error, try changing the DownloadFile function to:

Code: 
Private Function DownloadFile(URL As String, LocalFileName As String) As Boolean
    
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Dim retVal As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Dim retVal As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    DeleteUrlCacheEntry URL
    retVal = URLDownloadToFile(0, URL, LocalFileName, BINDF_GETNEWESTVERSION, 0)
    DownloadFile = (retVal = 0)

End Function
Also, I think the use of #If Win64 in the original API function declarations is incorrect. Use #If VBA7 instead, by replacing this code:
Code: 
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then '64-bit Office
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        (ByRef pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByRef lpfnCB As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]  '32-bit Office
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As Long
with:
Code: 
'https://msdn.microsoft.com/en-us/library/office/gg264421.aspx
'64-Bit Visual Basic for Applications Overview

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    'New VBA version 7 compiler, therefore >= Office 2010
    'PtrSafe means function works in 32-bit and 64-bit Office
    'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As LongPtr
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
        (ByVal lpszUrlName As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    'Old VBA version 6 or earlier compiler, therefore <= Office 2007
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
        (ByVal lpszUrlName As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
I've also included a link which explains the VBA7 directive and PtrSafe and LongPtr keywords.

However, it looks like the URL for displaying a location in Google Street View has changed since the code was posted. For the example address, "GooglePlex, CA 94043", and heading angle 90 degrees, the code generates the following URL:

HTML: 
http://maps.googleapis.com/maps/api/streetview?&location=GooglePlex,+CA+94043&size=512x512&heading=90&sensor=false
which displays a fixed image containing "The specified location could not be found". Therefore this code is now unable to display Google Street View images.
 
Upvote 0
You must log in or register to reply here.

Share this page

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