Return Array from Function
 

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

Return Array from Function
 

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

Return Array from Function
 

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