Picture and toggle button

[dave8]

I want to use a toggle button with an up and down arrow as picture. I want to display the up arrow when the toggle is true and down arrow when toggle is false. My up and down arrows are .bmp files sitting on my c:\ . So to reference the arrow buttons, I would have to change the Toggle_Button.Picture = "c:\up_arrow.bmp" property, whether true or false, correct? But if I transport my workbook to another computer, do I also need to copy the .bmp files over to the new computer in order for this to work??

 

[Jaafar Tribak]

You can also insert the bmps into the workbook ( In a hidden sheet for example ) and then copy them to the clipboard to create a Pic Object which you can then assign to the Picture Property of the Toggle button.

Alernatively, you can save the Bmps Files Bytes in worksheet cells and then recreate the bmp images and save them to disk on the fly when needed.

 

[dave8]

I'm not sure I understand how to do this. I just inserted the .bmp on my worksheet. From here, how do I reference it in my toggle property? Toggle_button.picture = sheets("Sheet1").picture("Picture 104") <---- doesn't work.

 

[Jaafar Tribak]

Sorry I was in hurry earlier on. Here is an example :

Workbook example.


Code in the Worksheet Module ( where the toggle button is embeeded )

Option Explicit
 
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
 
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
 
Private Declare Function CloseClipboard Lib "user32" () As Long
 
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long
 
'\\ Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
'\\ Declare a UDT to store the bitmap information
Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type
 
Private Const CF_BITMAP = 2
Private Const PICTYPE_BITMAP = 1
 
Private Function GetPicture(Object As Object) As IPicture
 
    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim IPic As IPicture
    Dim hPtr As Long
 
    '\\ Copy Object to ClipBoard
    Object.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    CloseClipboard
 
    '\\ Create the interface GUID for the picture
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
 
    '\\ Fill uPicInfo with necessary parts.
    With uPicinfo
        .Size = Len(uPicinfo) '\\ Length of structure.
        .Type = PICTYPE_BITMAP '\\ Type of Picture
        .hPic = hPtr '\\ Handle to image.
        .hPal = 0 '\\ Handle to palette (if bitmap).
    End With
 
   '\\ Create the Picture Object
   OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
 
    '\\ Ret Picture Object
   Set GetPicture = IPic
 
End Function
 
Private Sub ToggleButton1_Change()
 
    Dim oPic As IPicture
 
    If ToggleButton1.Value Then
        Set oPic = GetPicture(Me.Shapes("ArrowUp"))
        ToggleButton1.Picture = oPic
    Else
        Set oPic = GetPicture(Me.Shapes("ArrowDown"))
        ToggleButton1.Picture = oPic
    End If
 
End Sub

 

[dave8]

Thank you for the solution, but is there another easier way to accomplish this? And, will this work on 2007 & 2010??

 

[Jaafar Tribak]

Thank you for the solution, but is there another easier way to accomplish this? And, will this work on 2007 & 2010??

What's so difficult about the code ? You jsut need to know how to adapt it to your specific requirements.

It works on XL 2007 and I don't see why it shouldn't work on 2010.

I am not aware of a simpler solution unless you want to have two superposed toggle buttons each with its corresponding picture and alternate their visible property via code but that would IMO be more difficult and messy.

 

[dave8]

Is there a symbol table somewhere I can use?? A symbol table with look-alike arrows or pointers that I can access using the chr(xxx) or something like that??

Therefore,

If toggleButton1.value = True then
togglebutton1.caption = chr(xxx) ' up arrow symbol
else
togglebutton1.caption = chr(xxn) ' down arrow symbol
end if


Or something along these lines.

 

[Jaafar Tribak]

Dave.

You can achieve that by changing the font name of the togglebutton to Wingdings and the caption to the character é for the UpArrow and ê for the DownArrow but I could only do that at Design time via the Properties Window.

Unfortunately, I couldn't make this work at RunTime. Maybe someone can shed some light on this.

This and other variations don't seem to work :

ToggleButton1.Font.Name = "Wingdings"
ToggleButton1.Caption = "é"

 

[dave8]

I can't get it to work either. I did, however, implement your original suggestion in copying the images to the clipboard and creating objects. This works as intended but for some reason as I continue to test, there was an Excel error that pops up. The error is not consistent or frequent, but it does tend to sneak up. Its a critical error because it affects saving of the workbook: "Microsoft Office Excel cannot save this workbook because the control named ToggleButton1 does not support saving. To save the workbook, delete this control, and then try the save again". Once I de-reference the object, that is, not use it in the Togglebutton1, the workbook is fine.

 

[Jaafar Tribak]

I can't get it to work either. I did, however, implement your original suggestion in copying the images to the clipboard and creating objects. This works as intended but for some reason as I continue to test, there was an Excel error that pops up. The error is not consistent or frequent, but it does tend to sneak up. Its a critical error because it affects saving of the workbook: "Microsoft Office Excel cannot save this workbook because the control named ToggleButton1 does not support saving. To save the workbook, delete this control, and then try the save again". Once I de-reference the object, that is, not use it in the Togglebutton1, the workbook is fine.

Hi . I couldn't replicate the problem.

Try temporarly removing the picture like this and see if removes the problem:

Private Sub ToggleButton1_Change()
 
     Dim oPic As IPicture
    
     [COLOR=red]Set Me.ToggleButton1.Picture = Nothing
[/COLOR]    
    If ToggleButton1.Value Then
        Set oPic = GetPicture(Sheets(1).Shapes("ArrowUp"))
        Sheets(1).ToggleButton1.Picture = oPic
    Else
        Set oPic = GetPicture(Sheets(1).Shapes("ArrowDown"))
        Sheets(1).ToggleButton1.Picture = oPic
    End If
 
End Sub