vba excel shape

问题

I've used a small subroutine to insert a picture into my sheet by

ActiveSheet.Pictures.Insert(URL).Select

This works fine with Excel 2003 (Windows), but does not work with Excel 2011 (Mac) any more.

Therefore I modified my subroutine (like proposed http://www.launchexcel.com/google-maps-excel-demo/), but the subroutine stops at

theShape.Fill.UserPicture URL 

with the error message

"-2147024894 (80070002) Fehler der Methode UserPicture des Objekts FillFormat"

The rectangle is green!

Sub Q1()

Dim wks As Worksheet
Dim URL As String
Dim i As Long
Dim lastRow As Long
Dim theShape As Shape
Dim pasteCell As Range

' Used Worksheet
Set wks = Worksheets("Blatt1")

' Delete already existing shapes
For Each theShape In wks.Shapes
        theShape.Delete
Next theShape

' Check all existing rows in Column K
lastRow = Cells(Rows.Count, "K").End(xlUp).Row
For i = 2 To lastRow

' the URLs are already computed and stored in column K
URL = wks.Range("K" & i).Value

' try to put the images in column L
Set pasteCell = wks.Range("L" & i)
pasteCell.Select

' Create a Shape for putting the Image into
' ActiveSheet.Pictures.Insert(URL).Select is deprecated and does not work any more!!!
Set theShape = wks.Shapes.AddShape(msoShapeRectangle, pasteCell.Left, pasteCell.Top, 200, 200)

' fill the shape with the image after greening
theShape.Fill.BackColor.RGB = RGB(0, 255, 0)
theShape.Fill.UserPicture URL

Next i

End Sub

Any suggestions or hints? Probably I'm blind as a bat....

回答1:

Have you tried syntax along the lines of this for setting a shape to a URL:

Sub Picadder()

Dim Pic As Shape

Set Pic = ActiveSheet.Shapes.AddPicture("http://stackoverflow.com/content/stackoverflow/img/apple-touch-icon.png", msoFalse, msoTrue, 0, 0, 100, 100)

End Sub

This code, when adapted to your efforts, might look something along the lines of this:

Sub Q1()

Dim wks As Worksheet
Dim URL As String
Dim i As Long
Dim lastRow As Long
Dim theShape As Shape
Dim pasteCell As Range

' Used Worksheet
Set wks = Worksheets("Blatt1")

' Delete already existing shapes
For Each theShape In wks.Shapes
        theShape.Delete
Next theShape

' Check all existing rows in Column K
lastRow = Cells(Rows.Count, "K").End(xlUp).Row
For i = 2 To lastRow

' the URLs are already computed and stored in column K
URL = wks.Range("K" & i).Value

' try to put the images in column L
Set pasteCell = wks.Range("L" & i)
pasteCell.Select

' Create a Shape for putting the Image into
' ActiveSheet.Pictures.Insert(URL).Select is deprecated and does not work any more!!!
Set theShape = wks.Shapes.AddPicture(URL, pasteCell.Left, pasteCell.Top, 200, 200)

' Set shape image backcolor.
theShape.Fill.BackColor.RGB = RGB(0, 255, 0)

Next i

End Sub

Your urls will need to be properly formatted - I had to use quotations on my URL for the initial snippet to get it function effectively, but it may be a solution.

For Mac-Excel 2011, there is a workaround discussed by Michael McLaughlin on his blog. Evidently, it is not easy to tie images to cells in Mac-Excel 2011, if at all. Moreover, research reveals that the question of inserting images into an excel workbook has been asked many times. It also appears that it has not been readily solved through picture methods thus far in the research. Thus, a work-around may be the best solution.

The code snippet, which was very closely adapted and ported from Michael's blog, is as follows:

Function InsertImageCommentAsWorkAround(title As String, cellAddress As Range)

    ' Define variables used in the comment.
    Dim ImageCommentContainer As comment

  ' Clear any existing comments before adding new ones.
  Application.ActiveCell.ClearComments

  ' Define the comment as a local variable and assign the file name from the _
  ' _ cellAddress as an input parameter to the comment of a cell at its cellAddress.

  ' Add a comment.
  Set ImageCommentContainer = Application.ActiveCell.AddComment

  ' With the comment, set parameters.
  With ImageCommentContainer
    .Text Text:=""

        'With the shape overlaying the comment, set parameters.
        With .Shape
          .Fill.UserPicture (cellAddress.Value)
          .ScaleHeight 3#, msoFalse, msoScaleFormTopLeft
          .ScaleWidth 2.4, msoFalse, msoScaleFromTopLeft
        End With

  End With

  InsertImageCommentAsWorkAround = title

End Function

I would advise adapting the comment sets into your loop, and use that to set your images into place, using the shape formatting in your loop to set the formatting of the comment shapes generated by the adapted code.

来源：https://stackoverflow.com/questions/11844260/vba-excel-shape