Autoshape event handler?

[striderwho]

Hi all,

I need to draw a rectangle autoshape to the precise length that is
given by data in a separate sheet. I've managed to do this, but the
hard part is that if a user changes the length of this rectangle bar,
the data in the other sheet needs to be updated; and vice versa, if the
sheet is updated then the correct rectangle (there's more than one)
must be updated as well.

I think i can do the second part by using the Worksheet_Change
property, however I have no idea how to make the worksheet aware that
the user has changed an autoshape's size, and exactly which one has
changed (although i'm guessing if you can do the first bit, getting the
name of the shape should not be too hard). There doesn't seem to be
event handlers for autoshapes!

If anyone can help me with this problem, it'll be great!!

Thanks,
Jenny

 

[Peter T]

Hi Jenny,

Unfortunately the only event exposed by Shapes from the Drawing toolbar is
..OnAction, which calls the macro you've assigned to the shape. ActiveX
worksheet controls from the Control toolbox support various events but not
re-size, in any case not simple for user to manually resize without going
into design mode.

Maybe you could explain to your users how to resize your shape, (right click
border), then left click the shape to update whatever.

Sub ShapeUpdate()
Dim lt As Single, tp As Single
Dim wd As Single, ht As Single
Dim sName As String
Dim sAddr As String
Dim shp As Shape
Dim rng As Range

sName = Application.Caller
Set shp = ActiveSheet.Shapes(sName)

With shp
lt = .Left
tp = .Top
wd = .Width
ht = .Height
End With

Select Case sName
Case "Rectangle 1"
Set rng = Worksheets("Sheet1").Range("B1")
' more Case's
End Select

If MsgBox("Update cell " & rng.Address(0, 0, , True), _
vbOKCancel) = vbOK Then
rng.Value = wd
End If

End Sub

Regards,
Peter T

 

[Peter T]

Another thought - Charts expose a Deactivate event (amongst others) which
can be trapped in a collection of WithEvents chart class's.

If you think empty charts that look like rectangles would be OK, post back
and I'll try and put something together.

Regards,
Peter T

 

[NickHK]

Jenny,
Do they have to resize the bar directly ?
If you had slider, its change event could size the bar and it's value could
be linked to the cell in question

Private Sub scr_Change()
ActiveSheet.Shapes("rect").Width = scr.Value / 10
End Sub

NickHK

 

[striderwho]

Thanks for replying!

I'm presently about to get into bed and my problem is at work, so I'll
try to answer this somewhat intelligently and I'm sorry if it doesn't
sound like it!

This whole thing is meant to be some sort of interactive planner, so
these bars represent certain time intervals that are linked to the data
in the other sheets. The user may modify either the data or resize the
bars and they should be synchronised together. These bars also need
text on them (which changes as the bars are resized), colour-coded, and
will get increasingly complex as there are many sorts of information
that need to be overlaid on top.

I didn't think a chart object would be so flexible (and indeed, playing
with charts in Excel could not get me what I needed), so I'm making one
out of autoshapes.

Peter: The idea of using blank chart objects is intriguing. Given my
above requirements, do you think it'll work? You don't have to go
through all that trouble of hammering out working code, but tips would
be nice =).

Nick: Your suggestion was great too, but I think the client has this
thing about being able to manipulate the time intervals directly.

Thanks to the both of you!

Jenny

 

[Peter T]

Hi Jenny,

Based on what you added I think I'd explore Nick's suggestion. Try this -

On a new sheet, add a thin scroll bar from the Control toolbox menu, to the
max potential width of your rectangle. In properties
Max : 100 ' or the smallest "increment" you will need
Min : 0
Linkedcell : A1

While still in design mode, add a rectangle touching the top or bottom of
the scrollbar, adjust height but don't worry about left & width.

Select the scrollbar & rectangle and group them
Exit design mode

' in the worksheet module

Private Sub ScrollBar1_Change()
Dim w As Single, lt As Single, x As Single
' GroupObjects(1) is this ActiveX scrollBar and a Rectangle

Set shp = ActiveSheet.GroupObjects(1)
With ScrollBar1
x = .Value / .Max
w = .Width
lt = .Left
End With

shp.ShapeRange.GroupItems(2).Width = w * x
shp.ShapeRange.GroupItems(2).Left = lt
Range("B1").Value = x

End Sub

Adjust the scroll bar and the rectangle should width size in proportion to
value/max

Similarly if you adjust value in A1, but within the range min <> max

Could include other shapes within the same group. You can change individual
format properties of grouped items without ungrouping, but not text.

===============

Although no problem trapping the chart events, overall I can't see it being
a nice solution. But have a play with the following and it might give you
other ideas.

Code goes in 4 modules including a new class module

' in a normal module

Dim colCharts As Collection

Sub setChtEvents()
Dim i As Long
Dim clChart As Class1
Dim chtobj As ChartObject

Set colCharts = New Collection

For Each chtobj In ActiveSheet.ChartObjects
Set clChart = New Class1
Set clChart.cht = chtobj.Chart
clChart.m_wd = chtobj.Width
i = i + 1
Set clChart.m_rngLinked = Worksheets("Sheet1").Cells(i * 2, 2)
colCharts.Add clChart, chtobj.Name
Next

End Sub

Sub MakeChtObjects()
Dim i As Long

Set colCharts = Nothing

ActiveSheet.ChartObjects.Delete ' for testing

For i = 1 To 4
With ActiveSheet.ChartObjects.Add(100, _
Cells((i * 2), 1).Top, 200, 10)
.Name = "MyChart" & i
End With
Next

End Sub
'''''''''''''''''''''''''''''''''''''

' class module named Class1

Public WithEvents cht As Excel.Chart
Public m_wd As Single
Public m_rngLinked As Range


Private Sub cht_Deactivate()
Dim wdNew As Single

wdNew = cht.Parent.Width
If m_wd <> wdNew Then
m_rngLinked.Value = wdNew
m_wd = wdNew
End If

End Sub
'''''''''''''''''''''''''''''''''''''

' worksheet module containing chartobjects

Private Sub Worksheet_Activate()

'prevent chart toolbar from activating on this sheet ?
'Application.CommandBars("Chart Menu Bar").Enabled = False

setChtEvents
End Sub

Private Sub Worksheet_Deactivate()

Set colCharts = Nothing

Application.CommandBars("Chart Menu Bar").Enabled = True
End Sub

'''''''''''''''''''''''''''''''''''''''''''

' ThisWorkbook module

Private Sub Workbook_Open()
' Sheet1 codename of the sheet containing the chartobjects

If ActiveSheet Is Sheet1 Then
setChtEvents
End If
End Sub

'''''''''''''''''''''''''''''''''''''''

Run MakeChtObjects to make some charts, then setChtEvents

Manually change width of the chartobjects

Also look at the cht_MouseDown to return X coordinate, and the other events.

Maybe some cells as your target in a worksheet_change event to resize the
chart(s)

Regards,
Peter T

 

[Peter T]

PS,

shp.ShapeRange.GroupItems(2).

When I made my group, first item was the scrollbar and the rectangle was the
second. Better to name it, eg

shp.ShapeRange.GroupItems("Rectangle 2").

Peter T

 

[striderwho]

Thanks so much for your efforts! I'm going to take my time making sense
of it (I only starting learning VB last week!), I'll let you know how
it goes!

Jenny