GoogleMaps invoegen werkt goed in Excel 2003 en 2010 maar niet in 2007

[oceanrace]

Goedemorgen,
Ik heb een vreemd probleem met onderstaande code.
Het voegt heel mooi een google maps afbeelding in met markers van de adressen (sq, sq1 sq2 en sq3) in de
voorgeselecteerde cel: Set PictCell = Range("T49").
Dit gaat perfect in Excel 2003 en 2010 maar in Excel 2007 komt de afbeelding links boven in de hoek (waarschijnlijk A1) te staan.
Iemand een idee?

Sub Googlemaps() 
Dim Pict
Dim ImgFileFormat As String
Dim PictCell As Range
Dim Ans As Integer
On Error GoTo Fout
Sheets("Blad1").Select
Application.ScreenUpdating = False
sq = [E2] & "%20" & [J2] & "%20" & [Q2]
sq1 = [D43] & "%20" & [E43] & "%20" & [H43]
sq2 = [D44] & "%20" & [E44] & "%20" & [H44]
sq3 = [D45] & "%20" & [E45] & "%20" & [H45]

GetPict:
Pict = "http://maps.googleapis.com/maps/api/staticmap?&size=280x130&markers=color:blue%7C" & sq & "%7C" & sq1 & "%7C" & sq2 & "%7C" & sq3 & "&sensor=false" 

If Pict = False Then End

ActiveSheet.Unprotect "xxx"
GetCell:
Set PictCell = Range("T49") 'voorgeselecteerd
PictCell.Select
ActiveSheet.Pictures.Insert(Pict).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
 '   Selection.ShapeRange.Height = 90
 '   Selection.ShapeRange.Width = 150
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.Line.Weight = 1
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
ActiveSheet.Protect "xxx"
    Range("B8").Select
Application.ScreenUpdating = True
GoTo eind
Fout:
      MsgBox "Er is iets misgegaan" & vbCrLf & _
      "Mogelijke oorzaak:" & vbCrLf & _
      "Er is geen internetverbinding;" & vbCrLf & _
      "" & vbCrLf & _
      "Deze zoekfunctie kan nu niet worden gebruikt.", vbExclamation + vbOKOnly, "Oh oh..."

eind:
    Application.Statusbar = "Kaart gevonden en toegevoegd in blad1."
End Sub

 

[alphamax]

Sub Googlemaps()
    On Error GoTo Fout
    Application.ScreenUpdating = False
    sq = [E2] & "%20" & [J2] & "%20" & [Q2]
    sq1 = [D43] & "%20" & [E43] & "%20" & [H43]
    sq2 = [D44] & "%20" & [E44] & "%20" & [H44]
    sq3 = [D45] & "%20" & [E45] & "%20" & [H45]
    With Worksheets("Blad1").Pictures.Insert("http://maps.googleapis.com/maps/api/staticmap?&size=280x130&markers=color:blue%7C" & sq & "%7C" & sq1 & "%7C" & sq2 & "%7C" & sq3 & "&sensor=false")
         [COLOR="#FF0000"].Left = Range("T49").Left
         .Top = Range("T49").Top[/COLOR]
         With .ShapeRange
            .LockAspectRatio = msoFalse
            .Rotation = 0#
            With .Line
                .Weight = 1
                .DashStyle = msoLineSolid
                .Style = msoLineSingle
                .Transparency = 0#
                .Visible = msoTrue
                .ForeColor.SchemeColor = 64
                .BackColor.RGB = RGB(255, 255, 255)
            End With
        End With
    End With
    Range("B8").Select
    Application.StatusBar = "Kaart gevonden en toegevoegd in Blad1."
    Application.ScreenUpdating = True
    Exit Sub
Fout:
      MsgBox "Er is iets misgegaan" & vbCrLf & _
      "Mogelijke oorzaak:" & vbCrLf & _
      "Er is geen internetverbinding;" & vbCrLf & _
      "" & vbCrLf & _
      "Deze zoekfunctie kan nu niet worden gebruikt.", vbExclamation + vbOKOnly, "Oh oh..."
      Application.StatusBar = "Geen kaart gevonden en niet toegevoegd in Blad1."
End Sub

 

[oceanrace]

Bedankt, ik ga het uitproberen.

 

[oceanrace]

Het werkt, zou je me ook kunnen helpen met deze versie?
Hiermee selecteer ik een plaatje uit bestand.

Sub Afbeeldingmatrixreferentie2()
Dim Pict
Dim ImgFileFormat As String
Dim PictCell As Range
Dim Ans As Integer
On Error GoTo Fout
ActiveSheet.Unprotect
ImgFileFormat = ("Selecteer foto (*.gif; *.jpg; *.bmp; *.tif; *.png),*.gif; *.jpg; *.bmp; *.tif *.png")

GetPict:
Pict = Application.GetOpenFilename(ImgFileFormat)
'Note you can load in any nearly file format
If Pict = False Then End

GetCell:
Set PictCell = Range("Q39") 'voorgeselecteerd
PictCell.Select
ActiveSheet.Pictures.Insert(Pict).Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    'Selection.ShapeRange.Height = 222.75
    Selection.ShapeRange.Width = 283.5
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.Line.Weight = 1
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

GoTo eind
Fout:
      MsgBox "Er is iets misgegaan" & vbCrLf & _
      "Mogelijke oorzaak:" & vbCrLf & _
      "Er is geen internetverbinding;" & vbCrLf & _
      "" & vbCrLf & _
      "Deze zoekfunctie kan nu niet worden gebruikt.", vbExclamation + vbOKOnly, "Oh oh..."
eind:
    Application.Statusbar = "Afbeelding toegevoegd"
End Sub

 

[Warme bakkertje]

Sub Afbeeldingmatrixreferentie2()
On Error GoTo Fout
With ActiveSheet
    .Unprotect
    With .Pictures.Insert(Application.GetOpenFilename("Selecteer foto (*.gif; *.jpg; *.bmp; *.tif; *.png),*.gif; *.jpg; *.bmp; *.tif *.png"))
        .Left = Range("Q39").Left
        .Top = Range("Q39").Top
        With .ShapeRange
            .LockAspectRatio = msoTrue
            'Selection.ShapeRange.Height = 222.75
            .Width = 283.5
            .Rotation = 0#
            With .Line
                .Weight = 1
                .DashStyle = msoLineSolid
                .Style = msoLineSingle
                .Transparency = 0#
                .Visible = msoTrue
                .ForeColor.SchemeColor = 64
                .BackColor.RGB = RGB(255, 255, 255)
            End With
        End With
    End With
End With
GoTo eind
Fout:
      MsgBox "Er is iets misgegaan" & vbCrLf & _
      "Mogelijke oorzaak:" & vbCrLf & _
      "Er is geen afbeelding geselecteerd;" & vbCrLf & _
      "" & vbCrLf & _
      "Deze zoekfunctie kan nu niet worden gebruikt.", vbExclamation + vbOKOnly, "Oh oh..."
eind:
    Application.StatusBar = "Afbeelding toegevoegd"
End Sub

 

[oceanrace]

Alphamax en Rudi,
Bedankt voor jullie hulp.
De code is een stuk eenvoudiger via jullie manier!