June 26, 2014

Some old XP Stuff

??? what's it called ?? generic parameter pass ...
... TEST ::
Option Explicit
Option Base 0

Public Function Sqr(u As Variant) As Variant: Dim t
'vbEmpty 0 Empty (uninitialized)
'vbNull 1 Null (no valid data)
'vbInteger 2 Integer
'vbLong 3 Long integer
'vbSingle 4 Single-precision floating-point number
'vbDouble 5 Double-precision floating-point number
'vbCurrency 6 Currency value
'vbDate 7 Date value
'vbString 8 String
'vbObject 9 Object
'vbError 10 Error value
'vbBoolean 11 Boolean value
'vbVariant 12 Variant (used only with arrays of variants)
'vbDataObject 13 A data access object
'vbDecimal 14 Decimal value
'vbByte 17 Byte value
'vbUserDefinedType 36 Variants that contain user-defined types
'vbArray 8192 Array
t = VarType(u)
Select Case t
Case 2: Dim r2 As Integer: r2 = CInt(u * u): Sqr = r2
Case 3: Dim r3 As Long: r3 = CLng(u * u): Sqr = r3
Case 4: Dim r4 As Single: r4 = CSng(u * u): Sqr = r4
Case 5: Dim r5 As Double: r5 = CDbl(u * u): Sqr = r5
Case 6: Dim r6 As Currency: r6 = CCur(u * u): Sqr = r6
Case 11: Dim r11 As Boolean: r11 = CBool(u And u): Sqr = r11
Case 14: Dim r14 As Variant: r14 = CDec(u * u): Sqr = r14
Case 17: Dim r17 As Byte: r17 = CByte(u * u): Sqr = r17
Case Else: Dim r0 As String: r0 = "Error!": Sqr = r0
End Select
End Function

Private Sub INC(ByRef n0 As Variant, Optional n1 As Variant)
'MsgBox VarType(n1)
'MsgBox VarType(n1) & "=[" & n1 & "]"
Dim TpsT
TpsT = VarType(n1)
If TpsT = 10 Then n1 = 1
n0 = n0 + n1
End Sub

Private Sub DEC(ByRef n0 As Variant, Optional n1 As Variant)
Dim TpsT
TpsT = VarType(n1)
If TpsT = 10 Then n1 = 1
n0 = n0 - n1
End Sub

Public Sub TESTTEST()
Dim b0 As Byte, i0 As Integer, l0 As Long
b0 = b0 - b0: i0 = i0 - i0: l0 = l0 - l0: INC b0: INC i0, 2: INC l0, 3
MsgBox "inc(byte) " & b0 & " of " & TypeName(b0) & vbLf & _
       "inc(integer,2) " & i0 & " of " & TypeName(i0) & vbLf & _
       "inc(longint,3) " & l0 & " of " & TypeName(l0)
End Sub
TESTTEST() 's invoked by following code in ThisWorkbook.Workbook
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
If Sh.Name = "Sheet1" Then
If Target.SubAddress = "Sheet1!N32" Then
Call Module1.TESTTEST
End If
End If
End Sub

[EOF]

No comments: