VBA Lightbox? Code and Examples

[sjc4]

I have several cells filled with text. Is it possible to assign a Lightbox Macro to each of these cells so that when I double click them the text expands and comes forward (per se, the text "Lightboxes")?

here is an example of Lightbox if you don't know what it is:

http://www.blog.methodsinexcel.co.uk/2009/07/31/excel-lightbox-viewer/
http://www.juiceanalytics.com/writing/lightboxing-images-in-excel/

 

[Kenneth Hobson]

This is an interesting thread so I thought that I would tinker a bit. Since you are doing a range for the picture, filling a textbox shape is easy enough. This was recently discussed in: http://www.mrexcel.com/forum/showthread.php?t=568219

For the code below, add a CommandButton1 ActiveX control to your sheet. With a selected range, click the button. Click it again gives you an enlarged shape with parts going off the shape and on-top-of the first. Click button again to enlarge and repeat. Click the shapes to delete.

I found the original range values being shown as well so I set a background style which may not suit your needs.
Worksheet code:

Private Sub CommandButton1_Click()
  LightBoxSelection
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  LightBoxRange Target, Cancel
End Sub

Module1:

Sub LightBoxSelection()
  LightBoxRange Selection, False
End Sub

Sub LightBoxRange(Target As Range, Cancel As Boolean)
  Dim pic As Shape
  Dim I As Long
  Target.CopyPicture Appearance:=xlScreen, Format:=xlPicture

  ActiveSheet.Paste

  Set pic = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
  pic.BackgroundStyle = msoBackgroundStylePreset2
  'A bit browner with highlights
  'pic.BackgroundStyle = msoBackgroundStyleMixed + msoBackgroundStylePreset10 + msoBackgroundStylePreset2
  pic.Top = Target.Top

  For I = 10 To 200
      pic.Width = I
      pic.Height = I
  Next I

  pic.OnAction = "DeletePicture"

  Cancel = True

  Application.Goto Target
End Sub

Sub DeletePicture()
    ActiveSheet.Shapes(Application.Caller).Delete
End Sub


Sub t()
  Dim s As Shape
  Set s = ActiveSheet.Shapes("Oval1")
  s.BackgroundStyle
End Sub

 

[sjc4]

Thank you Mr. Hobson. Tmw after work I will give your code a try, and write back. We will see, as hopefully we have solved the debacle.

 

[baitmaster]

precicsley. displaying a text box would be the ideal situation. like you said, that is the way it is also done on the internet. do you have any ideas on how to display a text box?

See posts 2 and 3, that code should be adjustable enough to suit your needs. Play with label properties in the properties window until you get the look you want. Use target.text, .value, .formulaR1C1 etc to change what appears in the label. Use target.height, .width to change label.height, .width if necessary

 

[Norie]

What 'debacle'?

 

[baitmaster]

Debacle:
a ~ a great disaster; a complete failure or fiasco

I personally thought we did quite well... oh well, on to the next one...

 

[Norie]

baitmaster

Exactly.

 

[sjc4]

haha , baitmaster & norie you two did excellent! i appreciate your help!

best regards

 

[Norie]

Thanks.

I think this can be done but it would take a lot of time to put something together that wasn't for a specific purpose/workbook.