Question

我有一个代码可以在形状上创建形状，我希望它能够创建彼此相邻的形状而不是顶部。我怎样才能做到这一点？

  Sub removercaixas(strName As String)

    Dim shp As Shape
    For Each shp In Worksheets(2).Shapes
        If shp.Type = msoTextBox And shp.Name = strName Then shp.Delete
    Next shp

End Sub
Sub criarcaixastexto(strName As String)

    Dim wsActive As Worksheet
    Dim box As Shape

    Set wsActive = Worksheets(2)
    Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)

    box.TextFrame.Characters.Text = Worksheets(1).Range(strName).Value
    box.Name = strName

End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Select Case Target.Address
        Case "$A$1", "$A$2", "$A$3"
            removercaixas (Target.Address)
            If Len(Target) > 0 Then criarcaixastexto (Target.Address)
        Case Else
            Exit Sub
    End Select

End Sub

Answer 1

将create修改为以下内容会将每个文本框设置为相对于您要更改的单元格：

criarcaixastexto

形状VBA的相对定位

1 个答案: