Selva’s Site

The following code will help you create a drawing object on the sheet and the location, url, and link name can be customised as user will input those details.

- Selva V Pasupathy, HSBC Global Resourcing, Hyderabad1

Option Explicit
Private myCell As Range
Private myLeft, myTop, myWidth, myHeight
'     ________________________________________________________________________________
'
'     Written by  :        Selva V Pasupathy
'     Description :        The following macro will help you create
'                              a hyperlink object for you and link that
'                              object to url that you want.
'     site        :           http://socko.wordpress.com
'     ________________________________________________________________________________
'

Sub CreateMenuButton_link()
   Set myCell = Application.InputBox( _
    prompt:="Select a cell", Type:=8)

    myLeft = ActiveSheet.Range(myCell.Address).Left
    myTop = Range(myCell.Address).Top
    myWidth = Range(myCell.Address).Width
    myHeight = Range(myCell.Address).Height

    ActiveSheet.Shapes.AddShape( _
            msoShapeFlowchartTerminator, _
            myLeft, _
            myTop, _
            myWidth, _
            myHeight _
            ).Select
    Selection.Characters.Text = Link_Caption
    ActiveSheet.Hyperlinks.Add Anchor:= _
            Selection.ShapeRange.Item(1), _
            Address:=Link_Url
    With Selection
        .Font.Name = "Arial"
        .Font.Size = 8
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
        .AutoSize = False
    End With

    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Line.Visible = msoFalse
    On Error Resume Next
    ActiveSheet.Cells(1, 1).Select
End Sub
'_____________________________________________________________________________
Function Link_Caption() As String
   Link_Caption = Application.InputBox("Enter the caption for the link")
End Function
'_____________________________________________________________________________
Function Link_Url() As String
Url_Again:
   Link_Url = Application.InputBox("Enter url for the link")
   If Left(UCase$(Link_Url), 7)  "HTTP://" Then
      MsgBox "Plesae enter a valid URL that starts with <> "
      GoTo Url_Again
   End If
End Function

I came across the following codes at www.dailydoseofexcel.com. This code builds a UDF (User defined function) that can be used as a Excel Worksheet function, for e.g., Write “=ToWords(10284)” in a cell and enter, Excel calculates and returns a string “Ten Thousand Two Hundred Eighty Four”…
- Selva V Pasupathy, HSBC Global Resourcing, Hyderabad

Attribute VB_Name = "Module1"
Option Explicit
'  ____________________________________________________________
Public Function UnitString(ByVal Ind As Integer) As String
   Dim ToStr As Variant
   ToStr = Array("Zero", "One", "Two", _
                "Three", "Four", "Five", _
                "Six", "Seven", "Eight", _
                "Nine", "Ten", "Eleven", _
                "Tweleve", "Thirteen", _
                "Fourteen", "Fifteen", _
               "Sixteen", "Seventeen", _
               "Eighteen", "Nineteen", "Twenty")
   UnitString = ToStr(Ind)
End Function
'  ____________________________________________________________
Public Function TenString( _
                ByVal Ind As Integer _
                ) As String
   Dim ToStr As Variant
   ToStr = Array("Ten", "Twenty", "Thirty", _
            "Fourty", "Fifty", "Sixty", _
            "Seventy", "Eighty", "Ninety")
   TenString = ToStr(Ind)
End Function
'  ____________________________________________________________
Public Function PlaceString( _
            ByVal Ind As Integer _
            ) As String
   Dim ToStr As Variant
   ToStr = Array("Unit", "Tenth", "Hundred", _
                  "Thousand", "Lakh", "Crore", _
                  "Hundred" _
                 )
   PlaceString = ToStr(Ind)

End Function
'  ____________________________________________________________
Public Function ToWords(ByVal No As Long) _
                    As String
   Dim ToStr As String
   'Dim No As Long
   Dim Value As Long
   Dim Divisor As Long
   Dim i As Long

   Divisor = 1000000000

   i = 6
   Do While (No >= 1000)
      Value = Int(No / Divisor)
      No = No Mod Divisor
      Divisor = Int(Divisor / 100)
      If (Value <> 0) Then
         ToStr = ToStr & NumberToWords100(Value) _
                    & " " & PlaceString(i) + " "
      End If
      i = i - 1
   Loop

   Value = Int(No / 100)
   No = No Mod 100

   If (Value <> 0) Then
      ToStr = ToStr & NumberToWords100(Value) _
                & " " & PlaceString(i) + " "
   End If
   i = i - 1

   If No <> 0 Then
      ToStr = ToStr & NumberToWords100(No)
   End If
   ToWords = Trim(ToStr)
End Function
'  ____________________________________________________________
Private Function NumberToWords100( _
                ByVal No As Integer _
                ) As String
   Dim ToStr As String
   Dim Ten As Integer, Unit As Integer

   If (No <= 20) Then
      NumberToWords100 = UnitString(No)
      Exit Function
   End If
   No = No Mod 100
   Ten = Int(No / 10)
   No = No Mod 10
   Unit = No
   If (Ten >= 2) Then
      ToStr = ToStr & " " & TenString(Ten - 1)
      If (Unit > 0) Then
         ToStr = ToStr & " " & UnitString(Unit)
      End If
   ElseIf (Ten > 0) Then
      ToStr = ToStr & " " & UnitString((Ten * 10) + Unit)
   ElseIf (Unit > 0) Then
      ToStr = ToStr & " " & UnitString(Unit)
   End If

   NumberToWords100 = Trim(ToStr)
End Function
'  ____________________________________________________________
Private Sub Form_Load()
     MsgBox ToWords(10023)
End Sub