CODEWITHSUNDEEP
excelvba
David Leal
David Leal

Reputation: 6749

Find the cell location of the text box

I have created a text box using the following VBA function:

Function DrawPostIt(Left As Single, Top As Single, Width As Single, _
    Height As Single, Text As String) As String
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left, _
        Top, Width, Height).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 192, 0) ' Yellow post-it
        .Transparency = 0
        .Solid
    End With
    DrawPostIt = "BottomRightCell"
End Function

Now I would like to identify the cell location where excel drew the text box. I specifically need the cell location of the lower right corner. The objective is that DrawPostIt() function will return the cell position/location.

Note: Here I have found how to put a text box indicating the position based on the given cell (see), but that is not exactly what I want because I don't know upfront the cell location.

Upvotes: 0

Views: 1751

Answers (3)

jsotola
jsotola

Reputation: 2278

please try this

run testMe sub

Function drawPostIt(Left As Single, Top As Single, Width As Single, Height As Single, Text As String) As Range

    Dim aaa As Shape
    Set aaa = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left, Top, Width, Height)

    aaa.Title = "my fancy yellow post-it"
    aaa.TextFrame2.TextRange.Text = Text
    aaa.Fill.Visible = msoTrue
    aaa.Fill.ForeColor.RGB = RGB(255, 192, 0) ' Yellow post-it ... lol ... orange
    aaa.Fill.Transparency = 0
    aaa.Fill.Solid

'   aaa.TopLeftCell.Select                ' these two lines are for testing
'   aaa.BottomRightCell.Select            ' this is the range of interest

    Set drawPostIt = aaa.BottomRightCell

'   aaa.Delete                             ' for testing

End Function

Sub testMe()

    ActiveSheet.Range("a1").Select         ' move selection box out of the way (not needed though)

    Dim bottomRight As Range
    Set bottomRight = drawPostIt(50, 90, 120, 70, "message on postit")    ' drawPostIt() returns a range object

    bottomRight.Select                      ' drawPostIt() returns a range object

End Sub

Upvotes: 1

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Try this...

Sub CallTheFunction()
Dim Cell As Range
Set Cell = DrawPostIt(100, 150, 250, 150, "MyTextBox1")
MsgBox Cell.Address
End Sub

Function DrawPostIt(Left As Single, Top As Single, Width As Single, _
    Height As Single, Text As String) As Range
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left, _
        Top, Width, Height).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 192, 0) ' Yellow post-it
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Characters.Text = Text
    Set DrawPostIt = Selection.BottomRightCell
End Function

If you want to draw it in specific prior known cell, you may try this...

Sub CallTheFunction2()
Dim Cell As Range

Set Cell = Range("D5")  'Here you can defind the cell

DrawPostIt2 Cell.Left, Cell.Top, 200, 100, "MyTextBox2"
End Sub

Function DrawPostIt2(Left As Single, Top As Single, Width As Single, _
    Height As Single, Text As String)
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left, _
        Top, Width, Height).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 192, 0) ' Yellow post-it
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Characters.Text = Text
End Function

Upvotes: 2

Egan Wolf
Egan Wolf

Reputation: 3573

You can use BottomRightCell property of Shape object.

Selection.BottomRightCell.Address

It's better to set a reference to your text box than using Selection. Something like this:

Dim box as Shape
Set box = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Left, _
        Top, Width, Height)
With box.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 192, 0) ' Yellow post-it
    .Transparency = 0
    .Solid
End With

Upvotes: 1

Related Questions