I want to use the following subroutine as a function which will return array
aC. How would I declare it? Also, how would a sub then call the function
and display the results in a message box? TIA, James
Sub GetCoordsj()
Dim aC(1 To 4, 1 To 2) As Double
Dim bHflip As Boolean, bVflip As Boolean
Dim nBegin As Long, nEnd As Long
Dim shp As Shape

Set shp = ActiveSheet.Shapes(Selection.Name)
With shp
aC(1, 1) = .Left: aC(1, 2) = .Top
aC(2, 1) = .Left + .Width: aC(2, 2) = .Top
aC(3, 1) = .Left: aC(3, 2) = .Top + .Height
aC(4, 1) = .Left + .Width: aC(4, 2) = .Top + .Height

bHflip = .HorizontalFlip
bVflip = .VerticalFlip
End With

If bHflip = bVflip Then
If bVflip = False Then
'down to right
nBegin = 1: nEnd = 4
Else
'up to left
nBegin = 4: nEnd = 1
End If
ElseIf bHflip = False Then
'up to right
nBegin = 3: nEnd = 2
Else
'down to left
nBegin = 2: nEnd = 3
End If
' MsgBox "Begin X,Y " & aC(nBegin, 1) & ", " & aC(nBegin, 2) & Chr(13) _
' & "End X,Y " & aC(nEnd, 1) & ", " & aC(nEnd, 2)
End Sub

Sub GetCoordsj()
Dim aC as Variant
Dim bHflip As Boolean, bVflip As Boolean
Dim nBegin As Long, nEnd As Long
Dim shp As Shape

Set shp = ActiveSheet.Shapes(Selection.Name)

aC = fGetCoord(shp)
bHflip = shp.HorizontalFlip
bVflip = shp.VerticalFlip

If bHflip = bVflip Then
If bVflip = False Then
'down to right
nBegin = 1: nEnd = 4
Else
'up to left
nBegin = 4: nEnd = 1
End If
ElseIf bHflip = False Then
'up to right
nBegin = 3: nEnd = 2
Else
'down to left
nBegin = 2: nEnd = 3
End If
MsgBox "Begin X,Y " & aC(nBegin, 1) & ", " & aC(nBegin, 2) & Chr(13) _
& "End X,Y " & aC(nEnd, 1) & ", " & aC(nEnd, 2)
End Sub

Public Function fGetCoord(shp as Shape) as Variant
Dim aC(1 to 4, 1 to 2) as Double
With shp
aC(1, 1) = .Left: aC(1, 2) = .Top
aC(2, 1) = .Left + .Width: aC(2, 2) = .Top
aC(3, 1) = .Left: aC(3, 2) = .Top + .Height
aC(4, 1) = .Left + .Width: aC(4, 2) = .Top + .Height

End With
fGetCoord = aC
end Function


--
Regards,
Tom Ogilvy


"Zone" wrote in message
...
I want to use the following subroutine as a function which will return
array aC. How would I declare it? Also, how would a sub then call the
function and display the results in a message box? TIA, James
Sub GetCoordsj()
Dim aC(1 To 4, 1 To 2) As Double
Dim bHflip As Boolean, bVflip As Boolean
Dim nBegin As Long, nEnd As Long
Dim shp As Shape

Set shp = ActiveSheet.Shapes(Selection.Name)
With shp
aC(1, 1) = .Left: aC(1, 2) = .Top
aC(2, 1) = .Left + .Width: aC(2, 2) = .Top
aC(3, 1) = .Left: aC(3, 2) = .Top + .Height
aC(4, 1) = .Left + .Width: aC(4, 2) = .Top + .Height

bHflip = .HorizontalFlip
bVflip = .VerticalFlip
End With

If bHflip = bVflip Then
If bVflip = False Then
'down to right
nBegin = 1: nEnd = 4
Else
'up to left
nBegin = 4: nEnd = 1
End If
ElseIf bHflip = False Then
'up to right
nBegin = 3: nEnd = 2
Else
'down to left
nBegin = 2: nEnd = 3
End If
' MsgBox "Begin X,Y " & aC(nBegin, 1) & ", " & aC(nBegin, 2) & Chr(13) _
' & "End X,Y " & aC(nEnd, 1) & ", " & aC(nEnd, 2)
End Sub

Firstly have a look he

http://www.cpearson.com/excel/Passin...ningArrays.htm

I give you two methods to try:

The first is using arrays:

you return an array but also use byrefs for the other two items
----start 1--------

Option Explicit

Function GetCoordsj1(ByRef nBegin As Long, ByRef nEnd As Long) As Double()
Dim aC(1 To 4, 1 To 2) As Double
Dim bHflip As Boolean, bVflip As Boolean
Dim shp As Shape

Set shp = ActiveSheet.Shapes(Selection.Name)
With shp
aC(1, 1) = .Left: aC(1, 2) = .Top
aC(2, 1) = .Left + .Width: aC(2, 2) = .Top
aC(3, 1) = .Left: aC(3, 2) = .Top + .Height
aC(4, 1) = .Left + .Width: aC(4, 2) = .Top + .Height

bHflip = .HorizontalFlip
bVflip = .VerticalFlip
End With

If bHflip = bVflip Then
If bVflip = False Then
'down to right
nBegin = 1: nEnd = 4
Else
'up to left
nBegin = 4: nEnd = 1
End If
ElseIf bHflip = False Then
'up to right
nBegin = 3: nEnd = 2
Else
'down to left
nBegin = 2: nEnd = 3
End If
End Function

Sub test1()
Dim d() As Double
Dim nBegin As Long, nEnd As Long
d = GetCoordsj1(nBegin, nEnd)
MsgBox "Begin X,Y " & d(nBegin, 1) & ", " & d(nBegin, 2) & Chr(13) _
& "End X,Y " & d(nEnd, 1) & ", " & d(nEnd, 2)

End Sub

----end 1----------
the second is a user defined type:
---start 2--------

Option Explicit

Type MyCoordType
aC(1 To 4, 1 To 2) As Double
nBegin As Long
nEnd As Long
bStatus As Boolean
End Type

Function GetCoordsj2() As MyCoordType
Dim mct As MyCoordType
' Dim aC(1 To 4, 1 To 2) As Double
Dim bHflip As Boolean, bVflip As Boolean
Dim shp As Shape

On Error GoTo error_jump
mct.bStatus = False

Set shp = ActiveSheet.Shapes(Selection.Name)
With shp
mct.aC(1, 1) = .Left: mct.aC(1, 2) = .Top
mct.aC(2, 1) = .Left + .Width: mct.aC(2, 2) = .Top
mct.aC(3, 1) = .Left: mct.aC(3, 2) = .Top + .Height
mct.aC(4, 1) = .Left + .Width: mct.aC(4, 2) = .Top + .Height

bHflip = .HorizontalFlip
bVflip = .VerticalFlip
End With

If bHflip = bVflip Then
If bVflip = False Then
'down to right
mct.nBegin = 1: mct.nEnd = 4
Else
'up to left
mct.nBegin = 4: mct.nEnd = 1
End If
ElseIf bHflip = False Then
'up to right
mct.nBegin = 3: mct.nEnd = 2
Else
'down to left
mct.nBegin = 2: mct.nEnd = 3
End If
mct.bStatus = True
error_jump:
GetCoordsj2 = mct
End Function

Sub test2()
Dim mct2 As MyCoordType
mct2 = GetCoordsj2
If mct2.bStatus = True Then
MsgBox "Begin X,Y " & mct2.aC(mct2.nBegin, 1) & ", " & _
mct2.aC(mct2.nBegin, 2) & Chr(13) & "End X,Y " & _
mct2.aC(mct2.nEnd, 1) & ", " & _
mct2.aC(mct2.nEnd, 2)
Else
MsgBox "Error adjust as required.........", vbOKOnly, "Error"
End If
End Sub

----end 2==========

have a look and see what you think.

I personally prefer UDTs but they are not that effecient for large items.

--
Hope this helps
Martin Fishlock, Bangkok, Thailand
Please do not forget to rate this reply.


"Zone" wrote:

I want to use the following subroutine as a function which will return array
aC. How would I declare it? Also, how would a sub then call the function
and display the results in a message box? TIA, James
Sub GetCoordsj()
Dim aC(1 To 4, 1 To 2) As Double
Dim bHflip As Boolean, bVflip As Boolean
Dim nBegin As Long, nEnd As Long
Dim shp As Shape

Set shp = ActiveSheet.Shapes(Selection.Name)
With shp
aC(1, 1) = .Left: aC(1, 2) = .Top
aC(2, 1) = .Left + .Width: aC(2, 2) = .Top
aC(3, 1) = .Left: aC(3, 2) = .Top + .Height
aC(4, 1) = .Left + .Width: aC(4, 2) = .Top + .Height

bHflip = .HorizontalFlip
bVflip = .VerticalFlip
End With

If bHflip = bVflip Then
If bVflip = False Then
'down to right
nBegin = 1: nEnd = 4
Else
'up to left
nBegin = 4: nEnd = 1
End If
ElseIf bHflip = False Then
'up to right
nBegin = 3: nEnd = 2
Else
'down to left
nBegin = 2: nEnd = 3
End If
' MsgBox "Begin X,Y " & aC(nBegin, 1) & ", " & aC(nBegin, 2) & Chr(13) _
' & "End X,Y " & aC(nEnd, 1) & ", " & aC(nEnd, 2)
End Sub