Shapes losing their powers

[SusaninHouston]

In a workbook with lock worksheets containing shapes that run macros, I have one (remote) user who has had the same corruption occur multiple times. What happens is that the shapes (mainly text boxes but also some small icon images used as buttons to run macros) become unlocked, lose their assigned names, and no longer run their macros. Some of the macro buttons compress; others are stretched. The only other visible symptom is that the row heights also get compressed. The worksheets stay locked; macros are safe in their locked modules.

Has anyone ever seen this before? Know what might be causing this?

 

[rlv01]

Some of the macro buttons compress; others are stretched. The only other visible symptom is that the row heights also get compressed.

You need to be sure that you set the shape property to "Don't move or size with cells"*. Otherwise what you describe will happen as users manipulate the screen, sort, or autofilter.

As far as "become unlocked". That description is very passive voice. It's been my experience that there is always a cause. Were it my workbook and my user, I would send that person a special version that would include some new shape audit code that would audit the all the shapes and flag any changes immediately in order to see what is going on.


*(could also be "Move but don't size with cells" depending on what you want to allow),

 

[SusaninHouston]

You need to be sure that you set the shape property to "Don't move or size with cells"*. Otherwise what you describe will happen as users manipulate the screen, sort, or autofilter.

As far as "become unlocked". That description is very passive voice. It's been my experience that there is always a cause. Were it my workbook and my user, I would send that person a special version that would include some new shape audit code that would audit the all the shapes and flag any changes immediately in order to see what is going on.


*(could also be "Move but don't size with cells" depending on what you want to allow),

Thanks for the suggestion -- But the shape properties are actually set to 'Move but don't size' and they stretch/compression phenomenon isn't consistent with what you'd see if an autofilter were used -- which is disallowed anyway since the sheets are protected. For example, 8 buttons on the left side of the screen are all identically compressed, but an identical set on the right is stretched. (The buttons were originally all the same size and located at the same height on the sheet.) The types of changes are not what you'd normally see if the user were changing them accidentally, in which case I'd expect more inconsistency.

As for 'becoming unlocked' -- Of course there's a cause, and that is what my question is -- what that cause might be. None of the macros refer to all of the shapes, and none would delete the shape names (they're all named) or de-assign macros. Shape grouping is not affected.

The other clue is that row-heights were changing. In the sheets, titles and headers are often in larger fonts, with the rows set to 'autosize'. The larger fonts and styles are retained, but the row height reverts back to the standard for the default font. Unlocking the sheet and setting the row back to 'autosize' restores the correct height.

You suggested sending the user a special version with shape audit code. Do you have a sample of what that might look like? Or what information it might provide?

 

[rlv01]

Do you have a sample of what that might look like? Or what information it might provide?

You will need to store information about each shape that must not change on the worksheet in question. Whether you store that information in a hidden worksheet, a file you read in, or some other data structure is up to you.

You then need a sub that loops though all the shapes on the worksheet and compares the information it finds against the stored information and flags any differences. How it flags and what it does with that information is again, up to you.

Call that sub from various event procedures. At a minimum, the worksheet Activate and Deactivate events. If it does not affect performance, then also possibly the SelectionChange event. Experiment.

Here is some general code to get worksheet shape info that can serve as a starting point.

Sub ShapesList()
    Dim WS As Worksheet
    Dim Sh As Shape
    Dim I As Integer

    Set WS = ActiveSheet

    Debug.Print "Worksheet: " & WS.Name
    Debug.Print "--------------------------------------------------------------------"
    For Each Sh In WS.Shapes
        On Error Resume Next
        If Sh.Type = msoGroup Then
            Debug.Print "---------begin group----------"
            Debug.Print "Shape Group: " & Sh.Name
            Debug.Print "GI:" & ShapeTypeDescription(Sh.Type)
            Debug.Print "Grouped Shapes: " & Sh.GroupItems.Count
            For I = 1 To Sh.GroupItems.Count
                With Sh.GroupItems(I)
                    Debug.Print "Shape Name: " & .Name
                    Debug.Print "Sh T:" & .Top
                    Debug.Print "Shape " & I & ":" & ShapeTypeDescription(.Type)
                    Debug.Print "Text : " & Application.WorksheetFunction.Clean(.TextFrame.Characters.Text)
                    Debug.Print "Sh H:" & .Height
                    Debug.Print "Sh W:" & .Width
                    Debug.Print "Sh L:" & .Left

                    Debug.Print "Sh BS:" & .BackgroundStyle
                    Debug.Print "Sh OnAction:" & .OnAction
                End With
            Next I
            Debug.Print "---------end group----------"
        Else
            Debug.Print "Shape Name: " & Sh.Name
            Debug.Print "Sh T:" & Sh.Top
            Debug.Print "GI:" & ShapeTypeDescription(Sh.Type)
            Debug.Print "Text : " & Application.WorksheetFunction.Clean(Sh.TextFrame.Characters.Text)
            Debug.Print "Sh H:" & Sh.Height
            Debug.Print "Sh W:" & Sh.Width
            Debug.Print "Sh L:" & Sh.Left
            Debug.Print "Sh BS:" & Sh.BackgroundStyle
            Debug.Print "Sh OnAction:" & Sh.OnAction
        End If
        Debug.Print "`````````````"
    Next Sh
End Sub

Function ShapeTypeDescription(ShapeType As MsoShapeType) As String
    Dim ResultStr As String

    Select Case ShapeType
    Case msoAutoShape                                                     'Enumeration = 1
        ResultStr = "AutoShape(msoAutoShape)"
    Case msoCallout                                                       'Enumeration = 2
        ResultStr = "Callout(msoCallout)"
    Case msoCanvas                                                        'Enumeration = 20
        ResultStr = "Canvas(msoCanvas)"
    Case msoChart                                                         'Enumeration = 3
        ResultStr = "Chart(msoChart)"
    Case msoComment                                                       'Enumeration = 4
        ResultStr = "Comment(msoComment)"
    Case msoDiagram                                                       'Enumeration = 21
        ResultStr = "Diagram(msoDiagram)"
    Case msoEmbeddedOLEObject                                             'Enumeration = 7
        ResultStr = "Embedded OLE object (msoEmbeddedOLEObject)"
    Case msoFormControl                                                   'Enumeration = 8
        ResultStr = "Form control (msoFormControl)"
    Case msoFreeform                                                      'Enumeration = 5
        ResultStr = "Freeform(msoFreeform)"
    Case msoGroup                                                         'Enumeration = 6
        ResultStr = "Group(msoGroup)"
    Case msoInk                                                           'Enumeration = 22
        ResultStr = "Ink(msoInk)"
    Case msoInkComment                                                    'Enumeration = 23
        ResultStr = "Ink comment (msoInkComment)"
    Case msoLine                                                          'Enumeration = 9
        ResultStr = "Line(msoLine)"
    Case msoLinkedOLEObject                                               'Enumeration = 10
        ResultStr = "Linked OLE object (msoLinkedOLEObject)"
    Case msoLinkedPicture                                                 'Enumeration = 11
        ResultStr = "Linked picture (msoLinkedPicture)"
    Case msoMedia                                                         'Enumeration = 16
        ResultStr = "Media(msoMedia)"
    Case msoOLEControlObject                                              'Enumeration = 12
        ResultStr = "OLE control object (msoOLEControlObject)"
    Case msoPicture                                                       'Enumeration = 13
        ResultStr = "Picture(msoPicture)"
    Case msoPlaceholder                                                   'Enumeration = 14
        ResultStr = "Placeholder(msoPlaceholder)"
    Case msoScriptAnchor                                                  'Enumeration = 18
        ResultStr = "Script anchor (msoScriptAnchor)"
    Case msoShapeTypeMixed                                                'Enumeration = -2
        ResultStr = "Mixed shape type (msoShapeTypeMixed)"
    Case msoTable                                                         'Enumeration = 19
        ResultStr = "Table(msoTable)"
    Case msoTextBox                                                       'Enumeration = 17
        ResultStr = "Text box (msoTextBox)"
    Case msoTextEffect                                                    'Enumeration = 15
        ResultStr = "Text effect (msoTextEffect)"
        'Case msoContentApp                                                    'Enumeration = 27 (not used in Excel)
        ' ResultStr = "Content Office Add-in (msoContentApp)"
        'Case msoIgxGraphic                                                    'Enumeration = 24 (not used in Excel)
        ' ResultStr = "SmartArt graphic (msoIgxGraphic)"
        'Case msoWebVideo                                                      'Enumeration = 26 (not used in Excel)
        ' ResultStr = "Web Video (msoWebVideo)"
    Case Else
        ResultStr = "Unknown Shape Type"
    End Select
    ShapeTypeDescription = ResultStr
End Function

 

[SusaninHouston]

Thanks for the code sample, but for a workbook containing 12 sheets with 5-30 shapes per sheet, this looks like a pretty cumbersome test. Plus, from what I'm seeing in the corrupted workbook, it just doesn't smell right...

The most critical problem is not that the shapes become unlocked or distorted, but rather that they lose their macro assignments. They stop working, even though the macros are still in the workbook. And it affects every single shape in every single sheet (even in shapes on hidden worksheets that the user never sees), which tells me it's system-wide. Code that looks for changes in each shape would likely trigger several hundred times all at once whenever 'it' happens.

Any other ideas?

 

[rlv01]

Thanks for the code sample, but for a workbook containing 12 sheets with 5-30 shapes per sheet, this looks like a pretty cumbersome test.

Depends on how much of a problem this is for you. But scanning 12 sheets of 30 shapes each is not a huge task. And you would not be doing that anyway. You'd mainly be scanning the activesheet.

The most critical problem is not that the shapes become unlocked or distorted, but rather that they lose their macro assignments.

The sample code I posted shows how to retrieve the name of the macro the shape's OnAction property is assigned to.

Code that looks for changes in each shape would likely trigger several hundred times all at once whenever 'it' happens.

Unlikely. The code will simply gather info on the shape's properties to see if something has changed them. It will not trigger the macro or run hundreds if times.

Any other ideas?

If you suspect file corruption, then I'd recommend salvaging your data and macros ASAP.

 

[SusaninHouston]

Reviewing your code, it looks like it would tell me the 'after' information on the shapes if they get changed. So the relevant information might be:

Before:
Name: mc_enter
On Action: enter

After:
Name: Shape 12
On Action: Shape 12_click


Or Before:
Name: FAQ
On Action: HelpNotes

After:
Name: image2.png (That's interesting - .png?)
On Action: image2.png_click

Isn't this all information I could see by looking at the Before / After versions? All of the shapes in the 'Before' (good) files have names and assigned macros. In the 'bad' version, the names and macro assignments are gone.


The data is all good and has already been transferred into an unaffected file (clean template). I didn't see anything that led me to suspect a data corruption -- no #REF!, links, circular logic, extended calculation times.

And the macros are all safe - unharmed in the original. (My first suspicion was that they'd saved down to .xlsx, then saved back up.)

The other 400+ users on the same template are unaffected and have been for 10+ years. It's just this one user or one of their PCs that has had this same problem three times so far, which is why I think it's something specific to their PC or settings.