开发者

Is there an Alternative to using the LoadPicture("bmp_or_icon_file_path") to loading Images in Excel 2007 VBA

I have an Excel 2007 Worksheet with many buttons and labels that act as menu options (i.e. user clicks the buttons, labels with images) and is presented with forms, or some thing else.

These images / icons for the buttons and labels are loaded in VBA by assigning the Picture property of the Control and calling LoadPicture() method with the full image file path as parameter, like So.

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

This method of loading images for buttons, other controls is causing 2 issues.

1) It creates a dependency on the image files and physical location for every user, so if a user does not have the drive mapped and files present, the VBA fails with runtime error of file or path not found.

2) The app gets very slow if the images are on a shared drive (which is the case)

I want to eliminate both issues and somehow load icons, images into control internally, without any external dependencies on external image files.

What is the best way to achieve this in Excel 2007 VBA?

I could not file any Visual Basic 6.0 / Visual Studio style "Resource File Editor" / featu开发者_运维问答re with which to accomplish this.

Please advice! thank you

-Shiva @ mycodetrip.com


I really hope that there is a easier way to do this, but this is the only one I found:

The Idea is: You keep the Pictures embedded in a Sheet and every time you want to set the pictures for the Command you export them from your worksheet to a file and load them through LoadPicture. The only way to export an embedded Picture through VBA that I found is by making it a Chart first.

The following code is based on 'Export pictures from Excel' from johnske

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

To Conclude: Loading the Images from a Mapped Networked Drive seems less messy, and there shouldn't be that much of a speed difference.


2 alternatives i can think of: form.img.picture=pastepicture , and = oleobjects("ActiveXPictureName").object.picture.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜