excel - VBA Excel 形状

Question

我使用了一个小子例程将图片插入到我的工作表中

ActiveSheet.Pictures.Insert(URL).Select

这适用于 Excel 2003 (Windows)，但不再适用于 Excel 2011 (Mac)。

因此我修改了我的子程序 (如建议的 http://www.launchexcel.com/google-maps-excel-demo/ )， 但子例程停止于

theShape.Fill.UserPicture URL 

带有错误消息

“-2147024894 (80070002) UserPicture des Objekts FillFormat 的方法”

矩形是绿色的!

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

有什么建议或提示吗？也许我像 bat 一样盲目......

Answer 1

您是否尝试过类似的语法来将形状设置为 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

这段代码，当适应你的努力时，可能看起来像这样:

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

您的网址需要正确格式化 - 我必须在初始片段的网址上使用引号才能使其有效运行，但这可能是一个解决方案。

对于 Mac-Excel 2011，Michael McLaughlin 讨论了一种解决方法在他的博客上。显然，在 Mac-Excel 2011 中将图像与单元格关联起来并不容易(如果有的话)。此外，研究表明，将图像插入 Excel 工作簿的问题已被多次询问。迄今为止的研究似乎还没有通过图像方法轻易解决这个问题。因此，变通办法可能是最好的解决方案。

代码片段是从 Michael 的博客中非常密切地改编和移植的，如下:

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

我建议将注释集调整到您的循环中，并使用它来将图像设置到位，使用循环中的形状格式设置由改编代码生成的注释形状的格式。