Searching for shapes & moving them ???? 1

[ribhead]

I have written a macro that will allow the user to enter text into rectangles that are already created then paste them in the cell they have already selected. My problem is when I paste the rectangles they don't want to cooperatre by fitting neatly in the cell. Is there a way after I paste to move it(tweak) somehow? If not should I try and use a For Next loop to find all the shapes? Because I'm not sure what that would look like either. Very Very Frustrating. Any help would be greatly appreciated.

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

Hi,

Each drawing object has Left, Top, Width and Height properties as well as the cell. So...

    For Each obj In ActiveSheet.DrawingObjects
        With obj
        .Top = .TopLeftCell.Top
        .Left = .TopLeftCell.Left
        .Width = .TopLeftCell.Width
        .Height = .TopLeftCell.Height
        End With
    Next

Hope this helps



Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

Is there a way I can do this right after I Paste the object? This way in case there are other objects that don't need to be moved? I'm being picky I know but I'm just wondering how after I paste the object I can select it by itself. I'm not sure how Excel figures object names because it seems like I copy rectangle 1 and after paste it becomes rectangle 34 due to other objects being in the workbook.

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

Here's what you can do. Enter this code in the sheet object code module...

right click the sheet tab and select view code

Sub SizeDrawingObject()
    On Error GoTo ExitSub
    With ActiveSheet
        With .Shapes(.Shapes.Count)
            .Top = .TopLeftCell.Top
            .Left = .TopLeftCell.Left
            .Width = .TopLeftCell.Width
            .Height = .TopLeftCell.Height
        End With
    End With
ExitSub:
    Err.Clear
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    SizeDrawingObject
End Sub

After inserting a drawing object and selecting a cell, the Worksheet_SelectionChange event calls the
SizeDrawingObject procedure.

Hope this helps

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

This works but for only one object unfortunately I have grouped objects. How would this code change?

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

It seems to work for a group. I used the following process...

1. Create multiple shapes (the cell where your cursor first touches is the cell in which the shapes will reside)
2. group shapes
3. select a cell



Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

Well I had three rectangles that I grouped and I made a button to which I assigned the macro. When I clicked the buttton for one rectangle it worked great. When I clicked the button for a group(three rectangles) the group vanished. I guess I should ask are we talking about the first code or the second code that you sent me? I used the first one and it worked great for one rectangle. By the way on the second one what is the count for (.Shapes.count). Take it easy on me I'm very green here.

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

This has all been based on the SECOND code I sent.

Here's what the code means...

With ActiveSheet
   With .Shapes(.Shapes.Count)

   End With
End With

On the active sheet (With ActiveSheet),
reference the Shapes Collection With .Shapes
and get the last Shape in the Collection (.Shapes.Count)

The With...End With is a way of stating a reference. It is equivalent to...

ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Top = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).TopLeftCell.Top
etc.....

VB has to do alot more work in the latter case AND it is harder to read and understand.

Hope this helps




Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

Thanks a lot skip I just don't know how to find this type of coding. I can't find it in any books that I've read and I've never had a class so it's hard to understand some of this stuff I don't know if it's advanced or not but man you get my vote for programmer of the year.

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

Well, it's not in any books I have read. I use the Watches Window ALOT to hunt for properties that seem like they might work, use Help alot, Object Browser and a general knowledge of objects and collections.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

Watches Window? What the heck is that? by the wayI've got one other little problem with my program.

Let me break it down for ya.

1. User is asked for information via input box that information is then put in to the shapes(rectangles).

2. I then group the three rectangles and paste it in to a cell that the user has already selected.

3. I then use the code that you gave me to align the new group in to the cell.

4. I then need to go back to the original three shapes and ungroup them so I can start the process all over again. But every time I ungroup and regroup the group name changes so I guess I need to do a For each statement to ungroup them eh? Could that be like your program?
.with.Shapes.Count
.Ungroup??????

Thanks a lot you've been a huge help.


I may not be very smart but I'm sure wirey!!!!

 

[ribhead]

Oops I accidentally started a new post but this is what I came up with. I still don't know what the Watch window is and I have a hard time using the Object Browser effectively but I'll keep practicing. Thanks again skip.

With ActiveSheet
With .Shapes(.Shapes.Count)
.Ungroup.Select
End With
End With

End Sub

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

1. menu item View/Watch Window - opens a Watches Window
2. right click on a variable or object in your code and select Add Watch...
3. step thru your code and what happens to your entry. For collection, you can open the collection and see all kinds of neat info!

In my code, its set up to always act on the LAST item in the Shapes collection -- which is the last one added to the collection.

So if you want to go back a do stuff with previously added/grouped shapes, its a different ball game. Gotta figure out a way to identify the shapes you want to work on, like whats selected, for instance. So if you ungroup some then you regroup, BEFORE YOU UNSELECT THE SHAPES, run this macro...

Sub SizeDrawingObjectGroup()
    On Error GoTo ExitSub
    With Selection
        .Top = .TopLeftCell.Top
        .Left = .TopLeftCell.Left
        .Width = .TopLeftCell.Width
        .Height = .TopLeftCell.Height
    End With
ExitSub:
    Err.Clear
End Sub

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

That's what I'm doing I'm ungrouping them then adding text then grouping them. The code that I pasted worked and now it doesn't work? I'm going crazy.

With ActiveSheet
With .Shapes(.Shapes.Count)
.Ungroup.Select
End With
End With

End Sub

This should ungroup all the shapes on the active worksheet right? I thought it did but now it throws up an Invalid or unqualified reference alarm. I feel like Charlie Brown.

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

I just gave you a DIFFERENT macro called "SizeDrawingObjectGroup" that does not fire autaomtically like the previous one does. You must...

BEFORE YOU UNSELECT THE SHAPES, run this macro

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

Sorry I'm frustrating you but I dont' think the last macro helps me. I have objects that I already know the names of. I'm putting text in to those objects but they have to be ungrouped in order to do so (right?). So after I put the text in I group them copy them then paste them in to a cell that the user has already selected. I just need to make sure that I can ungrpoup them so I can add text and I could have sworn that the code that I pasted in the post above worked but now it doesn't. All the code you have given me works and works great but I need to ungroup these objects before text can be added. After that I can "bring it on home." with the help you're giving me. I'm just not sure why that code to ungroup doesn't work.????

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

With ActiveSheet
   With .Shapes(.Shapes.Count)
      .Ungroup.Select
   End With
End With

must be run while a cell is selected NOT when any shapes are selected.

This will select ONLY the LAST Shape/Range that was added to the Shapes Collection.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

I get a 400 alarm when I run this now. I think I'll just swallow a bullet here I'm driving myself and you crazy. I made two rectangles grouped them selected a cell. then ran this macro and kaboom a 400 alarm comes up.

Sub imdumb()
Sheet1.Activate
With ActiveSheet
With .Shapes(.Shapes.Count)
.Ungroup.Select
End With
End With

I may not be very smart but I'm sure wirey!!!!

 

[SkipVought]

Once you have grouped, selected cell and run the imdumb macro, your macro UNGROUPS that group.

If you run it again WITHOUT REGROUPING THAT LAST GROUP, you will get a 400 error.

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[ribhead]

This is crazy. I did it again and it worked once I added a new shape. I would like to turn this in to a For each statement somehow so I can go through the active sheet and anything that is grouped will be ungrouped. Before I even attempt this is this possible?

I may not be very smart but I'm sure wirey!!!!