Slidebar (scrollbar) insertion through VBA

D

Dreiding

I am try to create a macro that will append a new row in my table. The
constraint is that some cells have to be equations and one cell needs to
contain a slide bar (scrollbar). I've tried the scrollbar from the "Forms"
toolbar and from the 'Control Toolbox' with limited success.
The 'Control Toolbox' Scrollbar can be properly placed within the cell, but
I don't have access to "Properties" to change the other characteristics
(linked cell, min value, max value..). To create this control I use:

Set sbSlide = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ScrollBar.1",
Link:=False, DisplayAsIcon:=False, Left:=Leftx, Top:=Topx, Width:=Widthx,
Height:= Heightx).

(The xSizes are the target cell's values)


The 'Forms' Scrollbar allows me some control of the properties, but
placement of the Scrollbar within the cell is inconsistent, at best. For
this I used:

Set sbSlide = ActiveSheet.ScrollBars.Add(Leftx, Topx, Widthx, Heightx)

How can I create the 'Control Toolbox' scrollbox so I can modify it's
properties?
How can I accurately place the 'Forms' scrollbox?

Any suggestions? Is there anotherway to have a slidebar to allow the user
to select a value? All I need is one working solution.

Thanks,
- Pat
 
D

Dave Peterson

First, I've found that having lots (whatever that means) of controls from the
control toolbox toolbar on a worksheet can cause trouble. If I don't need all
those properties, I'll use the controls from the Forms toolbar.

And if I need a common macro that works on each of those controls, I can assign
the same macro to each of them.

But you can assign those properties to a control from the Control toolbox
toolbar:

Option Explicit
Sub testme()

Dim OLEObj As OLEObject
With ActiveSheet.Range("A1:C1")
Set OLEObj = .Parent.OLEObjects.Add _
(ClassType:="Forms.ScrollBar.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=.Left, _
Top:=.Top, _
Width:=.Width, _
Height:=.Height)
End With

With OLEObj
.LinkedCell = .TopLeftCell.Address
With .Object
.Min = 5
.Max = 12
End With
End With
End Sub




Or you could use the scrollbar from the Forms toolbar:

Sub testme2()

Dim myScrollBar As ScrollBar

With ActiveSheet.Range("A3:C3")
Set myScrollBar = .Parent.ScrollBars.Add _
(Left:=.Left, _
Top:=.Top, _
Width:=.Width, _
Height:=.Height)
End With

With myScrollBar
.LinkedCell = .TopLeftCell.Address(external:=True)
.Min = 5
.Max = 12
.OnAction = "'" & ThisWorkbook.Name & "'!myMacro"
End With
End Sub
Sub myMacro()
Dim myScrollBar As ScrollBar

Set myScrollBar = ActiveSheet.ScrollBars(Application.Caller)

With myScrollBar
MsgBox .TopLeftCell.Address & vbLf & .Value
End With
End Sub
 
D

Dreiding

Dave, your example were great!. I'm getting to understand the differences
between the two scrollbars. I ran into a placement issues based on different
zoom settings and came up with this modification to your code. I also
defaulted to the ActiveCell:

Really appreciate you help!
- Pat

Sub testme()
Dim OLEObj As OLEObject
Dim Leftx, Topx, Widthx, Heightx As Long

With ActiveCell
Set OLEObj = .Parent.OLEObjects.Add _
(ClassType:="Forms.ScrollBar.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=.Left, _
Top:=.Top, _
Width:=.Width, _
Height:=.Height)

Leftx = .Left
Topx = .Top
Widthx = .Width
Heightx = .Height

End With

With OLEObj
Debug.Print .Left, .Top, .Width, .Height
.LinkedCell = ActiveCell.Address
.Placement = xlMoveAndSize
.Left = Leftx
.Top = Topx
.Width = Widthx
.Height = Heightx
Debug.Print .Left, .Top, .Width, .Height

With .Object
.Min = 5
.Max = 12
.SmallChange = 1
.LargeChange = 5
End With
End With
End Sub
 
D

Dave Peterson

I've found it's always best to be at 100% zoom if I'm adding any controls. They
seem to respect the positioning in the code much better.

You could save the current zoom, set the zoom to 100%, do the work, and then
restore the original zoom level.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top