是否有替代方法可以使用 LoadPicture("bmp_or_icon_file_path") 在 Excel 2007 VBA 中加载图像

Question

我有一个 Excel 2007 工作表，其中包含许多用作菜单选项的按钮和标签（即用户单击按钮、带有图像的标签）并显示有表单或其他内容。

这些按钮和标签的图像/图标通过分配控件的 Picture 属性并使用完整的图像文件路径调用 LoadPicture() 方法在 VBA 中加载作为参数，如 So。

   With SomeFormObject
        .cmdOpenFile.Picture = LoadPicture("F:\projectname\images\fileopen.BMP")
   End With

这种为按钮和其他控件加载图像的方法会导致 2 个问题。

1) 它会为每个用户创建对映像文件和物理位置的依赖关系，因此如果用户没有映射驱动器和存在文件，VBA 将失败并出现文件运行时错误或找不到路径。
2) 如果图像位于共享驱动器上（就是这种情况），应用程序会变得非常慢

我想消除这两个问题，并以某种方式将图标、图像加载到内部控件中，而不需要对外部图像文件有任何外部依赖。

在 Excel 2007 VBA 中实现这一目标的最佳方法是什么？

我无法提交任何 Visual Basic 6.0/Visual Studio 风格的“资源文件编辑器”/功能来完成此操作。

请指教！谢谢

-湿婆@ mycodetrip.com

Answer 1

我真的希望有一种更简单的方法可以做到这一点，但这是我找到的唯一一种：

这个想法是： 您将图片嵌入工作表中，每次您想为命令设置图片时，您都将它们从工作表导出到文件并通过LoadPicture 加载它们。我发现通过 VBA 导出嵌入图片的唯一方法是先将其设为Chart。

以下代码基于 johnske

的 'Export pictures from Excel'

Option Explicit

Sub setAllPictures()
    setPicture "Picture 18", "CommandButtonOpen"
    setPicture "Picture 3", "CommandButtonClose"
End Sub

Sub setPicture(pictureName As String, commandName As String)
    Dim pictureSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim embeddedPicture As Picture
    Dim pictureChart As Chart

    Dim MyPicture As String
    Dim PicWidth As Long
    Dim PicHeight As Long

    Set pictureSheet = Sheets("NameOfYourPictureSheet") ' <- to Change '
    Set targetSheet = Sheets("NameOfYourSheet")  ' <- to Change '

    Set embeddedPicture = pictureSheet.Shapes(pictureName).OLEFormat.Object
    With embeddedPicture
        MyPicture = .Name
        PicHeight = .ShapeRange.Height
        PicWidth = .ShapeRange.Width
    End With

    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=pictureSheet.Name
    Set pictureChart = ActiveChart

    embeddedPicture.Border.LineStyle = 0

    With pictureChart.Parent
          .Width = PicWidth
          .Height = PicHeight
    End With

    With pictureSheet
        .Select
        .Shapes(MyPicture).Copy

        With pictureChart
            .ChartArea.Select
            .Paste
        End With

        .ChartObjects(1).Chart.Export Filename:="temp.jpg", FilterName:="jpg"
    End With

    pictureChart.Parent.Delete
    Application.ScreenUpdating = True

    targetSheet.Shapes(commandName).OLEFormat.Object.Object.Picture = LoadPicture("temp.jpg")

    Set pictureChart = Nothing
    Set embeddedPicture = Nothing
    Set targetSheet = Nothing
    Set pictureSheet = Nothing
End Sub

Sub listPictures()
    ' Helper Function to get the Names of the Picture-Shapes '
    Dim pictureSheet As Worksheet
    Dim sheetShape As Shape

    Set pictureSheet = Sheets("NameOfYourSheet")
    For Each sheetShape In pictureSheet.Shapes
        If Left(sheetShape.Name, 7) = "Picture" Then Debug.Print sheetShape.Name
    Next sheetShape

    Set sheetShape = Nothing
    Set pictureSheet = Nothing
End Sub

总结： 从映射的网络驱动器加载图像似乎不那么混乱，而且速度差异也不应该那么大。

Answer 2

我能想到的 2 个替代方案：form.img.picture=pastepicture 和 = oleobjects("ActiveXPictureName").object.picture。