将Google街景图像嵌入Excel

时间:2015-11-06 18:45:38

标签: excel vba google-maps google-maps-api-3

我正在尝试将Google街景嵌入Excel中。我发现这个link具有以下代码。对我来说根本不起作用,并寻求一些帮助来开始。显然,我需要为街景视图的URL查找设置变量。但我从来没有通过VBA插入图像,寻找一些指导。

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

    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

1 个答案:

答案 0 :(得分:1)

您可以通过将此行添加到GoogleStaticStreetView中的其他Dims来获取该代码:

Dim bRunMode As Boolean

然后运行此模块:

Sub makeThisCodeWork()
    GoogleStaticStreetView Sheets(1).Shapes.AddShape(msoShapeRectangle, 0, 0, 512, 512), "GooglePlex, CA 94043", 100
    Debug.Assert False
    Sheets(1).Shapes.Delete
End Sub

这只是创建一个矩形形状对象用作容器,然后让代码粘贴图像。

它会在到达debug.assert false时暂停执行,然后它将删除工作表上的所有形状,以便您可以再次清理它。你必须使用地址和标题变量来获得你想要的东西。

我没有尝试运行其他模块,因为那是为了返回地图,你只是说街景:)

希望这会有所帮助 - 如果您希望我更详细/解释这里发生的事情,请告诉我。