Группировка и присвоение имен фигурам в Excel с помощью vba

В Excel vba я создаю две фигуры в excel, используя vba. Стрелка, которую я называю «аро» + i, и текстовое поле, которое я называю «текст» + i, где i — число, обозначающее номер фотографии.

Итак, скажем, для фотографии 3 я создам стрелку «aro3» и текстовое поле «text3».

Затем я хочу сгруппировать их и переименовать эту группу в «аротекст» + i, поэтому в данном случае «аротекст3».

До сих пор я группировал и переименовывал вот так:

targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)).Select
Selection.group
Selection.Name = "AroTxt" & Number

который отлично работает в подпрограмме, но теперь я хочу превратить это в функцию и вернуть именованную группу, поэтому я попробовал что-то вроде этого:

Dim arrowBoxGroup as Object
set arrowBoxGroup = targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name))
arrowBoxGroup.group
arrowBoxGroup.Name = "AroTxt" & Number

Я сталкиваюсь с проблемами, когда создаю новую группу с тем же именем, что и уже созданная. Итак, если я создам вторые «аро3» и «текст3», а затем попытаюсь сгруппировать их и переименовать группу в «аротекст3», я получу ошибку, потому что группа с таким именем уже присутствует.

Чего я не понимаю, так это того, что когда я делал это, используя метод, относящийся к выбору, я мог бы переименовать каждую группу с одним и тем же именем, если бы захотел, и не получил бы ошибку.Почему это работает при ссылке на объект Selection, но не работает при попытке использовать назначенный объект?

ОБНОВЛЕНИЕ:

Поскольку кто-то спросил, код, который у меня есть, приведен ниже. стрелка и текстовое поле — это стрелка и текстовое поле, которые указывают направление, произвольно заданное пользователем с помощью формы.

Затем это создает стрелку под правильным углом на целевом листе и помещает текстовое поле с указанным номером (также через форму )в конце стрелки, так что оно эффективно формирует выноску. Я знаю, что есть выноски, но они не делают то, что я хочу, поэтому мне пришлось сделать свои собственные.

Я должен сгруппировать текстовое поле и стрелку, потому что 1 )они принадлежат друг другу, 2 )я отслеживаю, какие выноски уже были размещены, используя имя группы в качестве ссылки, 3 )пользователь должен разместить выноску в правильном месте на карте, встроенной в рабочий лист.

До сих пор мне удалось превратить это в функцию, сделав возвращаемое значение GroupObject. Но это по-прежнему зависит от Sheet.Shapes.range ().Select, что, на мой взгляд, очень плохой способ сделать это. Я ищу способ, который не зависит от объекта выбора.

И я хотел бы понять, почему это работает при использовании выбора, но не работает при использовании строго типизированных переменных для хранения объектов.

    Public Function MakeArrow(ByVal No As Integer, ByVal angle As Double, ByVal size As ArrowSize, ByVal ArrowX As Double, ByVal ArrowY As Double, ByVal TargetInternalAngle As Double, ByRef targetSheet As Worksheet) As GroupObject

    Dim Number As String
    Dim fontSize As Integer
    Dim textboxwidth As Integer
    Dim textboxheight As Integer
    Dim arrowScale As Double
    Dim X1 As Double
    Dim Y1 As Double
    Dim X2 As Double
    Dim Y2 As Double
    Dim xBox As Double
    Dim yBox As Double
    Dim testRange As Range
    Dim arrow As Shape
    Dim textBox As Shape
'    Dim arrowTextbox As ShapeRange
'    Dim arrowTextboxGroup As Variant

    Select Case size
        Case ArrowSize.normal
            fontSize = fontSizeNormal
            arrowScale = arrowScaleNormal
        Case ArrowSize.small
            fontSize = fontSizeSmall
            arrowScale = arrowScaleSmall
        Case ArrowSize.smaller
            fontSize = fontSizeSmaller
            arrowScale = arrowScaleSmaller
    End Select
    arrowScale = baseArrowLength * arrowScale

    'Estimate required text box width
    Number = Trim(CStr(No))
    Set testRange = shtTextWidth.Range("A1")
    testRange.value = Number
    testRange.Font.Name = "MS P明朝"
    testRange.Font.size = fontSize
    shtTextWidth.Columns(testRange.Column).EntireColumn.AutoFit
    shtTextWidth.Columns(testRange.row).EntireRow.AutoFit
    textboxwidth = testRange.Width * 0.8
    textboxheight = testRange.Height * 0.9
    testRange.Clear

    'Make arrow
    X1 = ArrowX
    Y1 = ArrowY
    X2 = X1 + arrowScale * Cos(angle)
    Y2 = Y1 - arrowScale * Sin(angle)
    Set arrow = AddArrow(X1, Y1, X2, Y2, Number, targetSheet)

    'Make text box
    Set textBox = Addtextbox(angle, Number, fontSize, X2, Y2, textboxwidth, textboxheight, TargetInternalAngle, targetSheet)

    'Group arrow and test box
    targetSheet.shapes.Range(Array(arrow.Name, textBox.Name)).group.Select
    Selection.Name = "AroTxt" & Number

    Set MakeArrow = Selection

'    Set arrowTextbox = targetSheet.shapes.Range(Array(arrow.Name, textBox.Name))
'    Set arrowTextboxGroup = arrowTextbox.group
'    arrowTextboxGroup.Name = "AroTxt" & Number
'
'    Set MakeArrow = arrowTextboxGroup

End Function

Private Function AddArrow(ByVal StartX As Double, ByVal StartY As Double, ByVal EndX As Double, ByVal EndY As Double, ByVal Number As String, ByRef targetSheet As Worksheet) As Shape

    Set AddArrow = targetSheet.shapes.AddLine(StartX, StartY, EndX, EndY)
    With AddArrow
       .Name = "Aro" & Number
        With.Line
           .BeginArrowheadStyle = msoArrowheadTriangle
           .BeginArrowheadLength = msoArrowheadLengthMedium
           .BeginArrowheadWidth = msoArrowheadWidthMedium
           .ForeColor.RGB = RGB(0, 0, 255)
        End With
    End With

End Function

Private Function Addtextbox(ByVal angle As Double, ByVal Number As String, ByVal fontSize As Integer, ByVal arrowEndX As Double, ByVal arrowEndY As Double, ByVal Width As Integer, ByVal Height As Integer, ByVal LimitAngle As Double, ByRef targetSheet As Worksheet) As Shape

    Dim xBox, yBox As Integer
    Dim PI As Double
    Dim horizontalAlignment As eTextBoxHorizontalAlignment
    Dim verticalAlignment As eTextBoxVerticalAlignment

    PI = 4 * Atn(1)

    If LimitAngle = 0 Then
        LimitAngle = PI / 4
    End If

    Select Case angle
        'Right
        Case 0 To LimitAngle, 2 * PI - LimitAngle To 2 * PI
            xBox = arrowEndX
            yBox = arrowEndY - Height / 2
            horizontalAlignment = eTextBoxHorizontalAlignment.left
            verticalAlignment = eTextBoxVerticalAlignment.Center
        'Top
        Case LimitAngle To PI - LimitAngle
            xBox = arrowEndX - Width / 2
            yBox = arrowEndY - Height
            horizontalAlignment = eTextBoxHorizontalAlignment.Middle
            verticalAlignment = eTextBoxVerticalAlignment.Bottom
        'Left
        Case PI - LimitAngle To PI + LimitAngle
            xBox = arrowEndX - Width
            yBox = arrowEndY - Height / 2
            horizontalAlignment = eTextBoxHorizontalAlignment.Right
            verticalAlignment = eTextBoxVerticalAlignment.Center
        'Bottom
        Case PI + LimitAngle To 2 * PI - LimitAngle
            xBox = arrowEndX - Width / 2
            yBox = arrowEndY
            horizontalAlignment = eTextBoxHorizontalAlignment.Middle
            verticalAlignment = eTextBoxVerticalAlignment.top
    End Select

    Set Addtextbox = targetSheet.shapes.Addtextbox(msoTextOrientationHorizontal, xBox, yBox, Width, Height)
    With Addtextbox
       .Name = "Txt" & Number
        With.TextFrame
           .AutoMargins = False
           .AutoSize = False
           .MarginLeft = 0#
           .MarginRight = 0#
           .MarginTop = 0#
           .MarginBottom = 0#
            Select Case verticalAlignment
                Case eTextBoxVerticalAlignment.Bottom
                   .verticalAlignment = xlVAlignBottom
                Case eTextBoxVerticalAlignment.Center
                   .verticalAlignment = xlVAlignCenter
                Case eTextBoxVerticalAlignment.top
                   .verticalAlignment = xlVAlignTop
            End Select
            Select Case horizontalAlignment
                Case eTextBoxHorizontalAlignment.left
                   .horizontalAlignment = xlHAlignLeft
                Case eTextBoxHorizontalAlignment.Middle
                   .horizontalAlignment = xlHAlignCenter
                Case eTextBoxHorizontalAlignment.Right
                   .horizontalAlignment = xlHAlignRight
            End Select
            With.Characters
               .Text = Number
                With.Font
                   .Name = "MS P明朝"
                   .FontStyle = "標準"
                   .size = fontSize
                   .Strikethrough = False
                   .Superscript = False
                   .Subscript = False
                   .OutlineFont = False
                   .Shadow = False
                   .Underline = xlUnderlineStyleNone
                   .ColorIndex = xlAutomatic
                End With
            End With
        End With
       .Fill.Visible = msoFalse
       .Fill.Solid
       .Fill.Transparency = 1#
        With.Line
           .Weight = 0.75
           .DashStyle = msoLineSolid
           .style = msoLineSingle
           .Transparency = 0#
           .Visible = msoFalse
        End With
    End With


End Function
5
задан yu_ominae 21 August 2012 в 07:35
поделиться