Question

更新 ：问题似乎与加载项的用户表单有关。我的解决方法是使用.SaveAs，关闭复制的工作簿，卸载表单然后重新打开复制的工作簿。对我做错了什么想法？

我有一个VBA加载项，它有一个打开工作簿的简单例程，使用.SaveAs创建一个副本然后结束。

复制的工作簿仍处于打开状态，似乎没问题，但所有Excel菜单都被禁用。如果我切换到另一个工作簿并返回，菜单似乎被重置/启用。

有关如何解决此问题的任何想法？

这是我的菜单代码：

Public Function fxCreateMenu() As Integer

Dim cbControl As CommandBarControl, bControlExists As Boolean

On Error Resume Next
With Application.CommandBars("Worksheet Menu Bar")
    .Visible = True
'\Check if Menu is already loaded
    For Each cbControl In .Controls
        If cbControl.Caption = gsMenuName Then
            bControlExists = True
            Exit For
        End If
        'Debug.Print cbControl.Caption
    Next cbControl
'\Check if Menu is NOT already loaded...
        If Not bControlExists Then
            With .Controls
                    With .Add(msoControlPopup)
                            .Caption = gsMenuName
                            With .Controls
                                    With .Add(msoControlButton)
                                        .Caption = "&GIA"
                                        .OnAction = "AE_ShowGIA"
                                    End With

                            End With
                    End With
            End With
        End If
    End With
End Function

这是我复制工作簿的代码

Public Function fxCreateTEMPLATE() As Integer

On Error GoTo Err_CreateTEMPLATE

Dim fileSaveName As Variant
Dim wbTemp As Workbook
Dim strPW As String

'\copy system template

'\open template
Workbooks.Open ThisWorkbook.Path & "\GIATemplate.xlsm", Password:=gstrPW, ReadOnly:=True  '"\GerrityRRTmp.xlsm", Password:=strPW
Set wbTemp = ActiveWorkbook

'\prompt user to save template
fileSaveName = Application.GetSaveAsFilename(InitialFileName:="My GIA", FileFilter:="Excel XLSM File (*.XLSM), *.XLSM", FilterIndex:="52", Title:="Save As")

If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName
    wbTemp.SaveAs Filename:=fileSaveName, Password:=""
    fxCreateTEMPLATE = -1
Else
    '\Save As Cancelled
    fxCreateTEMPLATE = 0
    wbTemp.Close
    GoTo Exit_CreateTEMPLATE
End If

Exit_CreateTEMPLATE:
Set wbTemp = Nothing
DoEvents
fxCreateTEMPLATE = -1
Exit Function

Err_CreateTEMPLATE:
Select Case Err
    Case 0
        Resume Next

    Case Else
        MsgBox "Error # " & Err.Number & " - " & Err.Description, vbCritical, "Error copying template."
        Resume Next
        fxCreateTEMPLATE = 0            
        GoTo Exit_CreateTEMPLATE


End Select

End Function

制作工作簿副本后禁用Excel菜单

0 个答案: