Error Trying To Remove Macro Assignment to Shapes

[Ark68]

I have this code which I am using to rid of the respective macros assigned to 11 different shapes on my worksheet. Each shape is named wthr_btn_# where # is a value between 1 and 11.

    With ws_gui    
       For wbtn = 1 To 11
            swbtn = "wthr_btn_" & wbtn
            With .Shapes(swbtn)
                .OnAction = "" 'removes macro assignments
                .Fill.ForeColor.RGB = vbWhite
                .Line.Weight = 0.25
                .Line.ForeColor.RGB = vbBlack
            End With
        Next wbtn
     End With

The line in red is stopping the code with an error. "Application defined or object defined error".
swbtn = "wthr_btn_1"
wthr_btn_1 has a macro assigned to it: "pkdata_3.xlsm!btn_mclr"

Suggestions to overcome the error?

 

[Zot]

Something like this

Sub Try()

Dim Shp As Shape

With ws_gui
    For wbtn = 1 To 11
        swbtn = "wthr_btn_" & wbtn
        Set Shp = .Shapes(swbtn)
        With Shp
            .OnAction = "" 'removes macro assignments
            .Fill.ForeColor.RGB = vbWhite
            .Line.Weight = 0.25
            .Line.ForeColor.RGB = vbBlack
        End With
    Next wbtn
End With

End Sub

 

[Ark68]

Hi Zot! Thank you for your suggestion, but despite the changes, I'm still getting the error.
Maybe it has something to do with the shape the macro is assigned. It is a grouped object, a rounded rectangle shape with a textbox superimposed over it. The variable swbtn refers to the name given to the rounded rectangle portion. Would I get this error if there was no macro assigned to shp (ie wthr_btn_1)? Perhaps when I assigned the macro through the right button mouse context menu it was being applied to the texbox? Or the group? Possible?

 

[Zot]

Hi Zot! Thank you for your suggestion, but despite the changes, I'm still getting the error.
Maybe it has something to do with the shape the macro is assigned. It is a grouped object, a rounded rectangle shape with a textbox superimposed over it. The variable swbtn refers to the name given to the rounded rectangle portion. Would I get this error if there was no macro assigned to shp (ie wthr_btn_1)? Perhaps when I assigned the macro through the right button mouse context menu it was being applied to the texbox? Or the group? Possible?

I don't have that extensive experience to answer your questions unfortunately I wonder why you need to superimpose the text since you can just add text to the shape.

Maybe our MVP like @Rick Rothstein can advise if that is the cause. Else I could try later

 

[BSALV]

remove macros from shapes

Hi all, I have several workbooks that each have about 20 sheets, and each sheet has dozens of shapes (text boxes, command buttons, ovals, etc.) and each shape has a macro assigned to it. What I want to do is disable the OnAction property from each shape with one macro. I have been able to do...

www.mrexcel.com

depends on what kind of shapes you're talking.

 

[Dan_W]

Knowing, as I do, that the goal here is to enable/disable the buttons/shapes, rather than remove the macros assigned to the shapes, wouldn't it make more sense to make the execution of the code conditional on something? So if the code is only executable once cells have been completed, or is no longer executable once cells cells are completed, you could test that at the outset of the code, and if it fails the test, you simply exit the sub.

 

[Ark68]

Hit Zot. My shape does allow text to be written directly in it, however, I can't get it to align properly within the narrow rounded rectangular shape. It seemed that superimposing a textbox where I needed the text was the way I had to go.

Hi Bsalv. Thank you for sharing that link. The code suggested as a solution is basically what I have already, and similar to the OP, the .OnAction is throwing the same error. The difference between me and the posted in that thread is I'm not using commandbuttons. That was where their errors were coming from if I understand correctly. I am working strictly with macro enabled buttons of grouped objects (shape and textbox).

Here is my code found in a worksheet module. The worksheet is unprotected at this stage.

    Dim swbtn as string
    Dim shp as shape
    With ws_gui  
        For wbtn = 1 To 11
            swbtn = "wthr_btn_" & wbtn
            Set shp = .Shapes(swbtn)
            With shp
                .OnAction = "" 'removes macro assignments
                .Fill.ForeColor.RGB = vbWhite
                .Line.Weight = 0.25
                .Line.ForeColor.RGB = vbBlack
            End With
        Next wbtn
     End With

 

[Ark68]

Hi Dave, not certain I catch your angle.
When I open the workbook, I'm wanting to default my worksheet (acting as a form of sort). As part of that default, I don't want the buttons to be clickable. Similar to what you are suggesting, my code is written that once the user enters specific infomation, the buttons are enabled. I enable them by assigning the shapes a macro. (untested because I haven't got to that point because of the error)

If Not Intersect(Target, Range("$F$7")) Is Nothing Then
        mbevents = False
        Unprotect
        'Range("Y4") = sZone
        Range("I7:J7").Locked = False
        With ws_gui
            .Shapes("wthr_btn_1").OnAction = "'" & ActiveWorkbook.Name & "!btn_mclr"
            .Shapes("wthr_btn_2").OnAction = "'" & ActiveWorkbook.Name & "!btn_ovc"
            .Shapes("wthr_btn_3").OnAction = "'" & ActiveWorkbook.Name & "!btn_mcl"
            .Shapes("wthr_btn_4").OnAction = "'" & ActiveWorkbook.Name & "!btn_flr"
            .Shapes("wthr_btn_5").OnAction = "'" & ActiveWorkbook.Name & "!btn_sql"
            .Shapes("wthr_btn_6").OnAction = "'" & ActiveWorkbook.Name & "!btn_snw"
            .Shapes("wthr_btn_7").OnAction = "'" & ActiveWorkbook.Name & "!btn_mxd"
            .Shapes("wthr_btn_8").OnAction = "'" & ActiveWorkbook.Name & "!btn_rain"
            .Shapes("wthr_btn_9").OnAction = "'" & ActiveWorkbook.Name & "!btn_fzr"
            .Shapes("wthr_btn_10").OnAction = "'" & ActiveWorkbook.Name & "!btn_wnd"
            .Shapes("wthr_btn_11").OnAction = "'" & ActiveWorkbook.Name & "!btn_clr"
        End With
        Range("I7").Select
        Protect
        mbevents = True
    End If

The problem is, I assume, these macros will remain attached to the buttons once the workbook is saved. So, they will need to be removed, either before closing, or in my case, when the workbook is opened.

The easiset option would be to hide the shapes until needed, but I want the user to know what lay ahead for them in terms of selection.

 

[Zot]

Hit Zot. My shape does allow text to be written directly in it, however, I can't get it to align properly within the narrow rounded rectangular shape. It seemed that superimposing a textbox where I needed the text was the way I had to go.

Hi Bsalv. Thank you for sharing that link. The code suggested as a solution is basically what I have already, and similar to the OP, the .OnAction is throwing the same error. The difference between me and the posted in that thread is I'm not using commandbuttons. That was where their errors were coming from if I understand correctly. I am working strictly with macro enabled buttons of grouped objects (shape and textbox).

Here is my code found in a worksheet module. The worksheet is unprotected at this stage.

    Dim swbtn as string
    Dim shp as shape
    With ws_gui
        For wbtn = 1 To 11
            swbtn = "wthr_btn_" & wbtn
            Set shp = .Shapes(swbtn)
            With shp
                .OnAction = "" 'removes macro assignments
                .Fill.ForeColor.RGB = vbWhite
                .Line.Weight = 0.25
                .Line.ForeColor.RGB = vbBlack
            End With
        Next wbtn
     End With

The grouping of the shape and textbox is causing the error as I tested it. Oooo.... you need to set the ws_guias worksheet too. I did not see that

 

[BSALV]

At least, do you have a clue which shape is giving you the problems.
If you look closer to that one, what is different ?
or in a loop

Private Sub CommandButton1_Click()
     For Each shp In ActiveSheet.Shapes
          MsgBox shp.TopLeftCell.Address & shp.Name & vbLf & shp.Type
          shp.OnAction = ""
      Next
End Sub