Image 除了使用LoadPicture（“bmp”或“U图标”文件“U路径”）在Excel 2007 VBA中加载图像外，还有其他方法吗

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

通过指定控件的Picture属性并调用LoadPicture（）方法，以完整图像文件路径作为参数，将按钮和标签的这些图像/图标加载到VBA中，如下所示

   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样式的“资源文件编辑器”/功能来完成此任务

请指教！多谢各位

-湿婆@

---

我真的希望有一种更简单的方法来做到这一点，但这是我发现的唯一一种方法：

这个想法是： 将图片嵌入到工作表中，每次要为命令设置图片时，都要将其从工作表导出到文件，并通过

LoadPicture

加载。通过我找到的VBA导出嵌入图片的唯一方法是首先将其制作成

图表

以下代码基于fromjohnske

选项显式
子集合所有图片（）
设置图片“图片18”，“命令按钮打开”
设置图片“图片3”，“命令按钮关闭”
端接头
子集合图片（pictureName为字符串，commandName为字符串）
暗淡的图片显示为工作表
将目标工作表变暗为工作表
暗嵌入图片作为图片
黯淡的图画如海图
将我的图片变暗为字符串
宽度与长度相同
高度与长度相同
Set pictureSheet=Sheets（“NameOfYourPictureSheet”）我能想到的两个备选方案：
form.img.picture=pastepicture
，和
=oleobjects（“ActiveXPictureName”）.object.picture
，谢谢你的代码片段和反馈！你是对的，将图像保存在一张纸上然后加载的方法确实会看到混乱和笨拙。W.r.t.使用映射网络驱动器，远程物理位置的用户会有明显的延迟。我说的是本地加载20个ui图标/图像需要2、3秒，而全国各地的用户只需2分钟左右。这就是我试图避免的，所以在映射驱动器中保留图像是不可能的。我想我可以使用应用程序重新分发图像，以便它们在本地加载，但这会建立对当前图像的依赖性..：(
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