Excel 2003 Macro not working in Excel 2010

OskarBravo

New Member
Joined
May 8, 2012
Messages
1
Hi all,

i can´t get this code to work correctly in Excel 2010. It is used to make simple organization charts, by pasting a Autoshape circle and connecting it with a line to another circle, this works fine.
The macro can also be used to remove the circle and line again by using the same command, this part doesn´t work anymore. I think the problems is that the circle is not pasted in to same place as in Excel 2003.

Any solutions?
Thanks in advance,
Oskar

Sub mcroInsertStructure()
'
'
' Keyboard Shortcut: Ctrl+s
'
On Error Resume Next
Range(Selection.TopLeftCell.Address).Select
Dim shloop As Shape
Dim r As Range
Set r = ActiveCell
Sheets("Symbols").Shapes("Oval 2").Copy
ActiveSheet.Paste
For Each shloop In ActiveSheet.Shapes
If (shloop.AutoShapeType = 9 Or shloop.AutoShapeType = 77) And shloop.Name <> Selection.Name Then
If shloop.Top = Selection.Top And shloop.Left = Selection.Left Then
Call DeleteConnector(shloop)
shloop.Delete
Selection.Delete
Exit Sub
End If
End If
Next shloop
Call mcroConnector
Range(r.Address).Select
End Sub

Sub mcroInsertAttribute()
'
' Keyboard Shortcut: Ctrl+a
'
On Error Resume Next
Range(Selection.TopLeftCell.Address).Select
Dim shloop As Shape
Dim r As Range
Set r = ActiveCell
Sheets("Symbols").Shapes("AutoShape 1").Copy
ActiveSheet.Paste
For Each shloop In ActiveSheet.Shapes
If (shloop.AutoShapeType = 9 Or shloop.AutoShapeType = 77) And shloop.Name <> Selection.Name Then
If shloop.Top = Selection.Top And shloop.Left = Selection.Left Then
Call DeleteConnector(shloop)
shloop.Delete
Selection.Delete
Exit Sub
End If
End If
Next shloop
Call mcroConnector
Range(r.Address).Select
End Sub

Sub DeleteConnector(s As Shape)
Dim ConncetorName As String
connectorname = mcroConnector()
Dim shloop As Shape
If connectorname <> "" Then
For Each shloop In ActiveSheet.Shapes
If shloop.Left = ActiveSheet.Shapes(connectorname).Left And _
shloop.Width = ActiveSheet.Shapes(connectorname).Width And _
shloop.Top = ActiveSheet.Shapes(connectorname).Top And _
shloop.Height = ActiveSheet.Shapes(connectorname).Height Then
shloop.Delete
ActiveSheet.Shapes(connectorname).Delete
Exit Sub
End If
Next shloop
End If
End Sub

Function mcroConnector() As String
On Error GoTo endsub
Dim sh As Shape
Dim shloop As Shape
Dim shEnd As String
Set sh = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 6.75, 11.25, 54.75, 34.5)
'Selection.ShapeRange.Flip msoFlipHorizontal
'Selection.ShapeRange.Flip msoFlipVertical
sh.ConnectorFormat.BeginConnect Selection.ShapeRange(1), 3
shEnd = ""
For Each shloop In ActiveSheet.Shapes
If shloop.AutoShapeType = 9 And shloop.Name <> Selection.ShapeRange(1).Name Then
If shloop.Top < Selection.ShapeRange(1).Top And shloop.Left < Selection.ShapeRange(1).Left Then
If shEnd = "" Then
shEnd = shloop.Name
Else
If shloop.Top >= ActiveSheet.Shapes(shEnd).Top Then
shEnd = shloop.Name
End If
End If
End If
End If
Next shloop
If shEnd = "" Then sh.Delete
sh.ConnectorFormat.EndConnect ActiveSheet.Shapes(shEnd), 5
mcroConnector = sh.Name

endsub:
End Function
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Forum statistics

Threads
1,215,831
Messages
6,127,143
Members
449,363
Latest member
Yap999

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top