5

Excel vba では、vba を使用して Excel で 2 つの図形を作成しています。「アロ」+ i と名付けた矢印と、「テキスト」+ i と名付けたテキストボックス (i は写真の番号を示す数字)。

ということで、写真3の矢印「aro3」とテキストボックス「text3」を作成します。

次に、それらをグループ化し、そのグループの名前を「arotext」+ i、つまりこの例では「arotext3」に変更します。

これまでのところ、次のようにグループ化と名前変更を行ってきました。

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

すでに作成されているグループと同じ名前の新しいグループを作成すると、問題が発生します。そのため、2 つ目の「aro3」と「text3」を作成してグループ化し、グループの名前を「arotext3」に変更しようとすると、同じ名前のグループが既に存在するため、エラーが発生します。

私が理解していないのは、選択を参照する方法を使用してこれを行った場合、必要に応じてすべてのグループの名前を同じ名前に変更でき、エラーが発生しないことです。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 = "ＭＳ Ｐ明朝"
    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
4

3 に答える 3

7

Range.Group は値を返します。あなたは試すことができます：

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

以前の作業で次のように現在の選択が更新されると思われます。

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

それが違いを引き起こしています。

参考までに、私は Excel 2010 を使用しており、Selection に基づいて元のコード スニペットを複製できません (「Selection.Name =」を実行するとエラーが発生し、オブジェクトがプロパティをサポートしていません)。

わかりました、これを機能させることができます：

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

もちろん、私が提案する他のスニペットと同様に、これはグループの戻り値を再割り当てするため、Selection.Group と Selection.Name の Selection は異なるオブジェクトを参照しています。これはあなたが望むものだと思います。

于 2012-08-21T00:35:30.733 に答える
0

このエラーが発生したのは、新しいグループを手動でオブジェクトとして保存しているためです。作成した「AroTxt」と Numberの複数のインスタンスでは、おそらく何もできません。Excel では、どのグループを意味するかを判断できません。

Excel はこれを許可すべきではありませんが、これが発生したことを常に警告するわけではなく、重複した名前を持つグループを選択しようとするとエラーが発生します。

そうでない場合でも、変数名を重複させることはお勧めできません。追加の Arrow と textBox をグループに追加した方がよいのではないでしょうか?

したがって、問題を解決するには、グループを保存する前に、グループが既に存在するかどうかを確認する必要があります。存在する場合は削除するか、グループに追加してください。

お役に立てれば

于 2012-08-20T12:48:52.180 に答える