vba excel 形状

vba excel shape

提问by TomThumb

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.

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

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

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

theShape.Fill.UserPicture URL 

with the error message

带有错误消息

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

“-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....

任何建议或提示？可能我像蝙蝠一样瞎了......

采纳答案by HymanOrangeLantern

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

您是否尝试过将形状设置为 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.

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

For Mac-Excel 2011, there is a workaround discussed by Michael McLaughlinon 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.

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

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.

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