找到文本框的单元格位置

时间:2017-07-14 22:06:51

标签: excel excel-vba vba

我使用以下VBA函数创建了一个文本框:

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

现在我想确定excel绘制文本框的单元格位置。我特别需要右下角的单元格位置。目标是DrawPostIt()函数将返回单元格位置/位置。

注意:在这里,我已经找到了如何根据给定的单元格(see)放置一个表示位置的文本框,但这不是我想要的,因为我没有&# 39;不知道小区的位置。

3 个答案:

答案 0 :(得分:2)

试试这个......

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

如果您想在特定的先前已知单元格中绘制它,您可以尝试这个...

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

答案 1 :(得分:1)

您可以使用BottomRightCell对象的Shape属性。

Selection.BottomRightCell.Address

最好设置对文本框的引用,而不是使用Selection。像这样:

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

答案 2 :(得分:1)

请试试这个

运行 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