3

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

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) Fehler der Methode 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

有什么建议或提示吗？大概我是个瞎子吧……

4

1 回答 1

2

您是否尝试过按照以下方式将形状设置为 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

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

于 2012-08-29T14:44:01.393 回答