Results 1 to 4 of 4

Thread: Square shapes change names when value from list change

  1. #1

    Square shapes change names when value from list change



    Register for a FREE account, and/
    or Log in to avoid these ads!

    I have file with VBA that change shape names based on 2 lists data...
    1 list contain data like home, building, elevator etc... second has digits 1.2.3 etc. so every shape match it's name in namebox (not text in shape) to those two lists like home1, home2, builidng1, building2 etc...
    check image Click for image

    Script works fine if you only changing first list home, building, elevator but what I need VBA change to shape names when I change second column and use text instead of numbers 1,2,3, so it will be like

    list1 list2
    home left

    so I change left to right and shape update it's name to homeright

    check file
    Click for file

    ShapesV2.xls

    VBA

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rng As Range
        Dim shp As Shape
        Dim nw As Variant
        Dim old As Variant
    
        ' in case there is an error...
        On Error GoTo CleanUp
        Set rng = Intersect(Target, [Shape])
        If Not rng Is Nothing Then
            ' Save new name
            nw = Target
            ' Prevent events firing while we change sheet values
            Application.EnableEvents = False
            ' Get previous name
            Application.Undo
            old = Target
            ' Restore new name
            Target = nw
            ' Rename selected Shapes
            For Each shp In Me.Shapes
                If shp.Name Like old & "#*" Then
                    shp.Name = nw & Mid(shp.Name, Len(old) + 1)
                End If
            Next
        End If
    CleanUp:
        ' Re-enable events
        Application.EnableEvents = True
    End Sub

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,021
    Articles
    79
    Blog Entries
    14
    Hi there, and welcome to the forum.

    Just as a heads up, if you click "Go Advanced", you can upload your workbook and images to my site, so you don't have to link elsewhere.

    With regards to your issue... the following code will do what you're asking but you do need to:
    • Expand your list a bit. Each "Home" record will need it's own line.
    • Make your entry match the shape name before you start changing it. i.e. if you create a new shape and it's called "Square1", you need to put "Square" in the shape column, then "1" in the Number column, then change what you're after.
    Here's the code:
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rng As Range
        Dim shp As Shape
        Dim nw As Variant
        Dim old As Variant
        ' in case there is an error...
        On Error GoTo CleanUp
        Set rng = Intersect(Target.EntireRow, [Shape:Number])
        Debug.Print rng.Address
        
        If Not rng Is Nothing Then
            ' Save new name
            nw = rng.Cells(1, 1) & "|" & rng.Cells(1, 2)
            ' Prevent events firing while we change sheet values
            Application.EnableEvents = False
            ' Get previous name
            Application.Undo
            old = rng.Cells(1, 1) & rng.Cells(1, 2)
            ' Restore new name
            rng.Value = Split(nw, "|")
            ' Rename selected Shapes
            For Each shp In Me.Shapes
                    Debug.Print shp.Name
                If shp.Name = old Then
                    shp.Name = Replace(nw, "|", "") 'nw & Mid(shp.Name, Len(old) + 1)
                    Exit For
                End If
            Next
        End If
    CleanUp:
        ' Re-enable events
        Application.EnableEvents = True
    End Sub
    PS.. Congratulations, you're post number 500 in the forum.
    Attached Files Attached Files
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3
    Hello Ken

    thank you for your reply

    500 and I wish more


    I tried this VBA and it changes shape name for first shape...
    problem is that in those 2 lists I need combination and unique values...

    Ok let me explain on this way
    lets look on this workbook like map of houses and every house has it's furniture (so I update data like that in file)...
    so sheet SHAPES has houses and furniture in 2 lists and combination of those 2 every shape is named on way house1table, house1chair... house2table, house2chair etc... every house same furniture...
    so what I need if I change home1 to house1 that all shapes that has home1 (like home1table,home1chair etc..) change to house1 (house1table, house1chair etc..), and also If I change word table to desk that all shapes contain word table (home1table, home2table, home3table) changes it's name to desk like (home1desk, home2desk, home3desk)...
    I need those combinations as on
    sheet TEXT there are cells in this file K6 is listbox that takes it's data from houses list sheet SHAPES and Cell L6 is llistbox that takes it's data from furniture list sheet SHAPES so if let say in K6 you select home1 and in L6 table there is VBA that created link and if you doubleclick on J6 it checks K6+L6 and goes to corespodent shape in this case home1table.....

    check file

    check images for explanation


    Click image for larger version. 

Name:	img1.jpg 
Views:	13 
Size:	99.4 KB 
ID:	325
    Click image for larger version. 

Name:	img2.jpg 
Views:	8 
Size:	96.7 KB 
ID:	327

    Thank you
    Attached Files Attached Files
    Last edited by lenis; 2011-10-22 at 09:17 AM.

  4. #4
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,021
    Articles
    79
    Blog Entries
    14
    Hi there,

    I'll try and look at this one later tonight if no one gets to it first.
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •