新增VBA宏及自定义Ribbon XML后PPT Ribbon无法正常访问问题求助

我在自定义PPT工具栏中新增了一个宏后，出现了整个PPT Ribbon无法访问的问题：Ribbon仅在首次打开时可正常使用，运行该新增宏后，所有PPT Ribbon控件均停止响应。我已确认该问题是在使用自定义Ribbon XML添加功能项后触发的，请问是否支持上传pptm文件供排查，我后续会附上对应文件，感谢协助。

新增按钮对应的Ribbon XML代码 #

<button id="btnUnifyIcons2"
        label="Unify Icons"
        imageMso="DataGraphicIconSet"
        supertip="Converts the selected icons/groups/shapes into default ZEN icons and Liberty Mutual icons for Constructs creation."
        onAction="Module1.ShowUnifyIconForm"  /> 

新增的宏代码 #

Sub ShowUnifyIconForm()
    frmUnifyIcons.Show
End Sub

Sub unifyIconOptions(iconType As String)
    If Not icw_CheckReg Then Exit Sub

    Dim shp, shpNew, objShp As Shape
    Dim shpNum, iRem As Integer

    shpNum = 1
    'Dim strFilepath, strExtn As String
    'strFilepath = "C:\Zen\ZenPic"
    'strExtn = ".jpg"
    Dim oSource As Presentation
    '
    For Each shp In ActiveWindow.Selection.ShapeRange
        iRem = shpNum Mod 8
        If iRem = 0 Then iRem = 8

        If shp.Type = msoGroup Or shp.Type = msoAutoShape Or shp.Type = msoFreeform Or shp.Type = 28 Or shp.Type = msoPicture Then
            Set oSource = Presentations.Open("C:\Zen\ZenLibrary.pptx", msoFalse, msoFalse, msoTrue)
            oSource.Slides(1).Shapes(iconType & iRem).Copy
            oSource.Close
            With ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
                .Shapes.Paste
                With .Shapes(.Shapes.Count)
                    .Left = shp.Left
                    .Top = shp.Top
                    .LockAspectRatio = msoTrue
                    .Height = shp.Height
                    .Width = shp.Width
                End With
            End With
            shp.Delete

        End If
        shpNum = shpNum + 1
    Next

End Sub

frmunifyIcons窗体代码 #

Private Sub cmdApply_Click()
    Dim iType As String
    If ZenIcon.Value Then
        iType = "ZenIcon"
    ElseIf LibertyBlueIcon.Value Then
        iType = "LibertyBlueIcon"
    ElseIf LibertyWhiteIcon.Value Then
        iType = "LibertyWhiteIcon"
    End If
    unifyIconOptions (iType)
    Unload Me
End Sub

问题现象截图 #

内容的提问来源于stack exchange，提问作者Jegan