Grouping and Creating a Texbox + A Shape VBA

[ericmax79]

[FONT=Verdana, serif]Helloguys[/FONT][FONT=Verdana, serif] [/FONT][FONT=Verdana, serif]
Icould use a little help . I want to insert a box .....Then " Adda textbox "at the same time . Preferably i would like to groupit as well. So that when i move the rectangle the text box isattached to it . Could someone please help guide me . I am very newto vba and just staring out . I really want to group it upon itscreation u Know ....Thank you guys happy computing[/FONT][FONT=Verdana, serif] [/FONT][FONT=Verdana, serif]


EricMaxfield ....[/FONT][FONT=Verdana, serif] [/FONT][FONT=Verdana, serif]

[/FONT]

[COLOR=#333333][FONT=Verdana, serif][SIZE=2]

SubDrawRect() '


Set myDocument = ActiveSheet

WithmyDocument.Shapes.AddShape(msoShapeRectangle, _
480, 170, 200,200)
.Name = "A"
.Fill.Visible =msoFalse
.Line.ForeColor.RGB = RGB(48, 48, 48)
.Line.DashStyle= msoLineSolid

.Line.Weight = 2.5


End With

EndSub[/SIZE][/FONT][/COLOR]

 

[Andrew Poulsom]

Try:

Sub SelectAll_Click()
    Dim Shp As Shape
    Dim AllShapes() As Variant
    Dim i As Long
    With ActiveSheet
        For Each Shp In .Shapes
            If Shp.Type <> msoOLEControlObject And Shp.Type <> msoFormControl Then
                i = i + 1
                ReDim Preserve AllShapes(1 To i)
                AllShapes(i) = Shp.Name
            End If
        Next Shp
        .Shapes.Range(AllShapes).Group
    End With
End Sub

 

[ericmax79]

It Work all the way Down to

 .Shapes.Range(AllShapes).Group

Something Doing Andrew ?

 

[Andrew Poulsom]

It worked for me. On my test sheet I had a Rectangle, an Oval, a Straight Connector, a CommandButton from Form Controls and an ActiveX CommandButton. What do you have?

 

[ericmax79]

Something I'm Doing Excuse my Text ....

 

[ericmax79]

I have similiar Buttons as you stated . I Just got a "error" on the line i sent you above .......... "application defined or object defined error" . The shapes are rectangle and Connector lines i am trying to select. Does it matter that i "assigned a Name " to the rectangles and lines I created and want to select using your Code ? Thanks again .

 

[Andrew Poulsom]

It doesn't matter that you renamed them. Can you group the shapes manually?

 

[ericmax79]

I can andrew can i paste Some Other code i Found ? . and maybe you can manipulate it . I can select them all . But again I dont know the higher function Like you do . To exclude the OLE control Objects From Being Grouped ....After i select them all You know ..... I want to Only "Group" The Shapes My Friend . Not The buttons . Just Like you had it . But I received a "error" Is all

Sub group_all()
Dim varArr() As Variant
Dim shp As Shape
Dim intAnzahl As Integer
For Each shp In ActiveSheet.Shapes
intAnzahl = intAnzahl + 1
ReDim Preserve varArr(1 To intAnzahl)
varArr(intAnzahl) = shp.Name
Next
Set shp = ActiveSheet.Shapes.Range(varArr).Group
shp.Name = "All"
End Sub

 

[Andrew Poulsom]

That is effectively the same as the code I gave you. Do you want to put your workbook on a share like Box.com and post the URL so that I can take a look at it?

 

[ericmax79]

Yeah I dont know how to do that partner . I would love 2 . I Had that problem with other "shape Grouping " methods Partner . Does It Matter im using 2013 excel . I believe it requires a certain "name to properly function . Like " Selection.shapes.Range(AllShapes).Group . Your code runs fine all the way down to the previously mentioned line. " .Shapes.Range(AllShapes).Group "

 

[ericmax79]

Here Paul .Here's Some code that selects the shape by its name . Right ? Is that what this code does ? If So could I use it to "select " My Shapes . Being i have assigned a unique name to each of My Shapes . Thank you a ton . Your saving my butt Today .

Sub selectshapes()
Dim s As Shape, myarr(), n As Integer
ReDim myarr(Sheet4.shapes.Count)
For Each s In Sheet4.shapes
    If Not InStr(s.Name, "Combo") = 0 Then
         myarr(n) = s.Name
         n = n + 1
        End If
Next
ReDim Preserve myarr(n - 1)
    Sheet4.shapes.Range(myarr).Select

End Sub