Tạo nhóm và đặt tên các hình dạng trong Excel với vba

Question

Trong Excel vba, tôi đang tạo hai hình dạng trong excel bằng cách sử dụng vba. Một mũi tên, mà tôi đặt tên là "aro" + i và một hộp văn bản, mà tôi đặt tên là "văn bản" + i, trong đó tôi là một số cho biết số lượng ảnh.

Vì vậy, hãy nói cho ảnh 3 Tôi sẽ tạo mũi tên "aro3" và hộp văn bản "text3".

Sau đó tôi muốn nhóm chúng và đổi tên nhóm "arotext" + i, do đó "arotext3" trong trường hợp này.

Cho đến nay tôi đã và đang làm việc nhóm và đổi tên như thế này:

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

trong đó hoạt động xuất sắc trong một tiểu, nhưng bây giờ tôi muốn thay đổi điều này vào một hàm và trả lại nhóm có tên, vì vậy tôi cố gắng một cái gì đó như thế này:

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

Tôi gặp sự cố khi tạo nhóm mới có tên giống với tên đã được tạo. Vì vậy, nếu tôi tạo một "aro3" thứ hai và "text3" và sau đó cố gắng nhóm chúng và đổi tên nhóm thành "arotext3", tôi nhận được một lỗi vì một nhóm có cùng tên đã có mặt. Điều tôi không hiểu là khi tôi đã làm điều này bằng cách sử dụng phương pháp đề cập đến việc lựa chọn, tôi có thể đổi tên mỗi nhóm có cùng tên nếu tôi muốn và sẽ không nhận được một lỗi. Tại sao nó hoạt động khi tham chiếu đến đối tượng Selection, nhưng thất bại khi cố gắng sử dụng một đối tượng được gán?

CẬP NHẬT:

Vì ai đó đã hỏi, mã tôi có cho đến nay là dưới đây. mũi tên và hộp văn bản là một mũi tên và hộp văn bản hướng vào một hướng tùy ý do người dùng xác định bằng biểu mẫu.

Điều này sau đó tạo một mũi tên ở góc chính xác trên trang tính mục tiêu và đặt một hộp văn bản với số được chỉ định (cũng thông qua biểu mẫu) ở cuối mũi tên, để nó có hiệu quả tạo chú thích. Tôi biết rằng có những chú thích, nhưng họ không làm những gì tôi muốn vì vậy tôi phải tự làm.

Tôi phải nhóm hộp văn bản và mũi tên vì 1) chúng thuộc về nhau, 2) Tôi theo dõi chú dẫn nào đã được đặt bằng tên của nhóm làm tham chiếu, 3) người dùng phải đặt chú thích trong đúng vị trí trên bản đồ được nhúng trong trang tính.

Cho đến nay tôi đã quản lý để thực hiện điều này thành một hàm bằng cách đặt giá trị trả về thành GroupObject. Nhưng điều này vẫn còn dựa trên Sheet.Shapes.range() .Chọn, theo ý kiến ​​của tôi là một cách rất tồi tệ để làm điều này. Tôi đang tìm một cách mà không dựa vào đối tượng lựa chọn.

Và tôi muốn hiểu lý do tại sao điều này hoạt động khi sử dụng lựa chọn nhưng không thành công khi sử dụng các biến được nhập mạnh để giữ các đối tượng.

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 = "ＭＳ Ｐ明朝" 
    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 = "ＭＳ Ｐ明朝" 
        .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 

Answer 1

Phạm vi.Nhóm trả về giá trị. Bạn có thể thử:

Set arrowBoxRange = targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)) 
Set arrowBoxGroup = arrowBoxRange.Group 
arrowBoxGroup.Name = "AroTxt" & Number 

Tôi nghi ngờ rằng các lựa chọn hiện tại được cập nhật như sau trong công việc trước đây của bạn:

Set Selection = Selection.Group 'it's as if this is done for you when you create the group. 

mà đang gây ra sự khác biệt.

FYI, tôi đang sử dụng Excel 2010 và không thể lặp lại trong các đoạn mã ban đầu dựa trên Selection Tool (tôi nhận được một lỗi làm "Selection.Name =", mang đến cho đối tượng không hỗ trợ bất động sản.)

Ok, tôi có thể có được điều này để làm việc:

Selection.Group.Select 
Selection.Name = "AroTxt" 

Tất nhiên, giống như đoạn khác tôi đề nghị, đây reassigns giá trị trả về của nhóm, do đó lựa chọn trong Selection.Group và Selection.Name đang đề cập đến đối tượng khác nhau, mà tôi suy nghĩ là những gì bạn muốn.

Answer 2

Đó là vì bạn đang lưu trữ các nhóm mới dưới dạng đối tượng theo cách thủ công ngay bây giờ mà lỗi này đã xuất hiện. Có thể bạn không thể làm bất kỳ điều gì với nhiều phiên bản của "AroTxt" & Số mà bạn đã tạo. Như excel sẽ không thể quyết định nhóm bạn có ý nghĩa.

Excel không cho phép điều này nhưng không phải lúc nào cũng cảnh báo rằng điều này đã xảy ra nhưng sẽ bị lỗi nếu bạn cố gắng chọn một nhóm có tên trùng lặp.

Ngay cả khi đây không phải là trường hợp, thực tiễn không tốt là có tên biến trùng lặp. Nó sẽ không được tốt hơn để thêm thêm của Arrow và textBox của nhóm?

Vì vậy, để giải quyết vấn đề của bạn, bạn sẽ phải kiểm tra xem nhóm đã tồn tại trước khi bạn lưu nó chưa. Có thể xóa nó nếu tồn tại hoặc thêm vào nhóm.

Hope this helps

Answer 3

Edit: Vì nó luôn luôn có vẻ để đi, lỗi bắt đầu nảy lên sau khi tôi nhấp nộp. Tôi sẽ tinker xung quanh một chút nữa, nhưng sẽ echo @royka trong tự hỏi nếu bạn thực sự cần phải cung cấp cho cùng một tên cho nhiều hình dạng.

Mã bên dưới dường như làm những gì bạn đang tìm kiếm (tạo hình dạng, đặt tên cho chúng và sau đó nhóm). Trong chức năng nhóm, tôi để lại số "AroText" giống nhau chỉ để xem nếu có lỗi xảy ra (nó không). Có vẻ như cả hai hình dạng có cùng tên, nhưng những gì khác biệt chúng là Shape.ID của chúng. Từ những gì tôi có thể nói, nếu bạn nói ActiveSheet.Shapes("My Group").Select, nó sẽ chọn phần tử có tên đó với ID thấp nhất (như tại sao nó cho phép bạn đặt tên cho hai thứ cùng tên, không có đầu mối :)).

Nó không phải là một câu trả lời cho câu hỏi của bạn về "tại sao" (tôi đã không thể tái tạo lỗi), nhưng điều này hy vọng sẽ cung cấp cho bạn một cách "làm thế nào".

Sub SOTest() 

Dim Arrow As Shape 
Dim TextBox As Shape 
Dim i as Integer 
Dim Grouper As Variant 
Dim ws As Worksheet 

Set ws = ActiveSheet 

' Make two shapes and group, naming the group the same in both cases 
For i = 1 To 2 
    ' Create arrow with name "Aro" & i 
    Set Arrow = ws.Shapes.AddShape(msoShapeRightArrow, 10, 50, 30, 30) 
    Arrow.Name = "Aro" & i 

    ' Create text box with name "Text" & i 
    Set TextBox = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 40, 40) 
    TextBox.Name = "Text" & i 

    ' Use a group function to rename the shapes 
    Set Grouper = CreateGroup(ws, Arrow, TextBox, i) 

    ' See the identical names but differing IDs 
    Debug.Print "Name: " & Grouper.Name & " | ID: " & Grouper.ID 
Next 

End Sub 


Function CreateGroup(ws As Worksheet, Arrow As Shape, TextBox As Shape, Number As Integer) As Variant 

Dim arrowBoxGroup As Variant 

' Group the provided shapes and change the name 
Set arrowBoxGroup = ws.Shapes.Range(Array(Arrow.Name, TextBox.Name)).Group 
arrowBoxGroup.Name = "AroTxt" & Number 

' Return the grouped object 
Set CreateGroup = arrowBoxGroup 

End Function