एक्सा में वीबीए

Question

एक्सेल वीबीए में एक्सेल में आकार और नामकरण आकार, मैं vba का उपयोग कर एक्सेल में दो आकार बना रहा हूं। एक तीर, जिसे मैं "एरो" + i, और एक टेक्स्टबॉक्स नाम देता हूं, जिसे मैं "टेक्स्ट" + नाम देता हूं, जहां मैं एक तस्वीर की संख्या को इंगित करता हूं।

तो, तस्वीर 3 के लिए कहें मैं तीर "एरो 3" और टेक्स्टबॉक्स "टेक्स्ट 3" बनाउंगा।

मैं फिर उन्हें समूह बनाना चाहता हूं और उस समूह में "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 

मैं एक नया समूह बनाते समय समस्याओं में भाग लेता हूं जिसका नाम पहले से ही बनाया गया है। इसलिए, यदि मैं दूसरा "एरो 3" और "टेक्स्ट 3" बनाता हूं और फिर उन्हें समूहबद्ध करने का प्रयास करता हूं और समूह को "arotext3" में बदलता हूं तो मुझे एक त्रुटि मिलती है क्योंकि एक ही नाम वाला समूह पहले से मौजूद है।

जो चीज़ मुझे समझ में नहीं आती है वह यह है कि जब मैंने चयन का जिक्र करते हुए विधि का उपयोग करके ऐसा किया, तो मैं प्रत्येक समूह को उसी नाम से बदल सकता था अगर मैं चाहता था और कोई त्रुटि नहीं मिलेगी। चयन ऑब्जेक्ट का जिक्र करते समय यह क्यों काम करता है, लेकिन असाइन किए गए ऑब्जेक्ट का उपयोग करने का प्रयास करते समय विफल रहता है?

अद्यतन:

के बाद से किसी ने पूछा, कोड मैं अब तक राशि से कम है। तीर और टेक्स्टबॉक्स एक तीर और एक टेक्स्टबॉक्स है जो एक फॉर्म का उपयोग कर उपयोगकर्ता द्वारा मनमाने ढंग से परिभाषित दिशा में इंगित करता है।

यह फिर लक्ष्य वर्कशीट पर सही कोण पर एक तीर बनाता है और तीर के अंत में निर्दिष्ट संख्या (फॉर्म के माध्यम से) के साथ एक टेक्स्टबॉक्स रखता है, ताकि यह प्रभावी ढंग से कॉलआउट बना सके। मुझे पता है कि कॉलआउट हैं, लेकिन वे जो भी चाहते हैं वो नहीं करते हैं इसलिए मुझे अपना खुद का बनाना पड़ा।

मैं समूह के लिए पाठ बॉक्स और तीर है, क्योंकि 1) वे एक साथ हैं, 2) मैं ट्रैक जिनमें से कॉलआउट पहले से ही एक संदर्भ के रूप में समूह के नाम का उपयोग कर रखा गया है रखने के लिए, 3) उपयोगकर्ता में कॉल आउट जगह है वर्कशीट में एम्बेड किए गए मानचित्र पर सही स्थान।

अब तक मैंने इसे रिटर्न वैल्यू को ग्रुप ऑब्जेक्ट करके एक फ़ंक्शन में बनाने में कामयाब रहा है। लेकिन यह अभी भी शीट पर निर्भर करता है। Shapes.range()। चुनें, मेरी राय में यह करने का एक बहुत बुरा तरीका है। मैं एक ऐसे तरीके की तलाश में हूं जो चयन ऑब्जेक्ट पर भरोसा न करे।

और मैं समझना चाहता हूं कि चयन का उपयोग करते समय यह क्यों काम करता है, लेकिन वस्तुओं को पकड़ने के लिए मजबूत टाइप किए गए चर का उपयोग करते समय विफल रहता है।

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

रेंज। समूह एक मूल्य देता है। आप कोशिश कर सकते हैं:

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. 

जो अंतर पैदा कर रही है।

FYI करें, मैं Excel 2010 का उपयोग कर रहा है और चयन के आधार पर मूल कोड स्निपेट नकल नहीं कर सकते (मैं जो वस्तु संपत्ति का समर्थन नहीं करता देता है "कर रही Selection.Name =" एक त्रुटि, मिलता है।)

ठीक है, मैं इस काम करने के लिए प्राप्त कर सकते हैं:

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

बेशक

, अन्य टुकड़ा मैं सुझाव की तरह, इस समूह द्वारा दिया गया मान reassigns, ताकि Selection.Group और Selection.Name में चयन, विभिन्न वस्तुओं की बात कर रहे हैं जो मैं सोचो कि आप क्या चाहते हैं।

Answer 2

यह इसलिए क्योंकि आप एक वस्तु के रूप में नए समूहों भंडारण कर रहे हैं मैन्युअल रूप से अब है कि इस त्रुटि दिखाई दिया है। आप शायद "एरोटेक्स्ट" संख्या के कई उदाहरणों के साथ कुछ भी करने में सक्षम नहीं हैं। चूंकि एक्सेल यह तय करने में सक्षम नहीं होगा कि आप किस समूह का मतलब है।

एक्सेल को इसकी अनुमति नहीं देनी चाहिए, लेकिन यह हमेशा चेतावनी नहीं देता है कि यह हुआ है लेकिन यदि आप एक ऐसे समूह का चयन करने का प्रयास करते हैं जिसमें डुप्लिकेट नाम है।

भले ही यह मामला न हो, डुप्लिकेट वेरिएबल नाम रखने के लिए यह अच्छा अभ्यास नहीं है। क्या अतिरिक्त तीर और टेक्स्टबॉक्स को समूह में जोड़ना बेहतर नहीं होगा?

इसलिए अपनी समस्या का समाधान करने के लिए आपको यह जांचना होगा कि समूह सहेजने से पहले समूह पहले से मौजूद है या नहीं। यदि मौजूद है या समूह में जोड़ें तो शायद इसे हटा दें।

आशा इस मदद करता है

Answer 3

संपादित करें: यह हमेशा जाने के लिए लगता है के रूप में, त्रुटि पॉपिंग के बाद मैं प्रस्तुत क्लिक किया शुरू कर दिया। मैं थोड़ा और अधिक टिंकर कर दूंगा, लेकिन अगर आपको वास्तव में एक ही नाम को कई आकारों में देने की ज़रूरत है तो आश्चर्यचकित होकर @royka गूंज जाएगा।

नीचे दिया गया कोड ऐसा लगता है जो आप खोज रहे हैं (आकार बनाएं, उन्हें नाम दें और फिर समूह दें)। ग्रुपिंग फ़ंक्शन में, मैंने "एरोटेक्स्ट" नंबर छोड़ा, यह देखने के लिए कि क्या कोई त्रुटि होगी (ऐसा नहीं हुआ)। ऐसा लगता है कि दोनों आकारों का एक ही नाम है, लेकिन उन्हें क्या अंतर है Shape.ID। जो मैं बता सकता हूं, यदि आप ActiveSheet.Shapes("My Group").Select कहते हैं, तो वह उस नाम के साथ सबसे कम आईडी के साथ तत्व का चयन करेगा (इसीलिए यह आपको दो चीज़ों को एक ही नाम, कोई सुराग क्यों नहीं देता है :))।

यह "क्यों" (मैं त्रुटि को दोहराने में सक्षम नहीं था) के आपके प्रश्न का काफी जवाब नहीं है, लेकिन यह उम्मीद है कि आपको एक तरीका "कैसे" देगा।

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