在另存为对话框 Excel 中临时设置默认文件类型

Question

我正在为 Excel 中的宏插件制作模板。插件有一个奇怪的东西，当你关闭它们时，Excel 不会提示你保存。所以我希望我的所有插件都使用以下代码从模板继承：

Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
    'check for save because Excel doesn't prompt for addins
    'but save will fail if this is a new file, so fall back to default prompt then
    If Me.Path <> vbNullString And Not Me.Saved Then
        Select Case MsgBox("Wanna save before you quit?", vbQuestion + vbYesNoCancel, "Unsaved Changes")
            Case VbMsgBoxResult.vbYes
                Me.Save
            
            Case VbMsgBoxResult.vbCancel
                Cancel = True
                
        End Select
    End If
End Sub

现在我还希望将使用此模板制作的所有文件设置为插件：

'one shot ideally
Private Sub Workbook_Open()
    'only run on new files
    If Me.Path = vbNullString Then Me.IsAddin = True
End Sub

问题在于，对于从启用宏的模板 .xltm 创建的文件，Excel 默认保存为 .xlsm - 而不是 IsAddin 为 True 所需的 .xlam 插件文件

所以我可以补充：

Private Sub Workbook_Open()
    If Me.Path = vbNullString Then
        Me.IsAddin = True
        Application.DefaultSaveFormat = xlOpenXMLAddIn
    End If
End Sub

但这会为 Excel 中的所有文件设置默认值。我只想暂时更改默认值，直到该文件被保存或丢弃而不保存。 Workbook_BeforeSave 运行太晚，在 ui 显示为 xlsm 而不是 xlam 之后。

有什么想法吗？如果可以避免，我不想在创建时立即保存，因为我可能想丢弃文件而不保存。

Answer 1

我们不想在编辑实际的.xltm 模板时在Open 或BeforeClose 事件（或任何其他事件）中运行代码。这应该会有所帮助：

Public Function IsTemplate() As Boolean
    IsTemplate = (ThisWorkbook.FileFormat = xlOpenXMLTemplateMacroEnabled)
End Function

我们只需在每个事件方法的开头添加If IsTemplate() Then Exit Sub。

使用模板创建新文件后，有两种保存方式。由于文件变成了一个插件，用户不能真正点击 Excel 本身的保存按钮，但它可以从 VBE 中保存或关闭 Excel。

从 VB 编辑器保存

用户可以在编辑代码时按下 VBE 中的“保存”按钮或简单地从键盘上按 Ctrl+S。为此，我们可以使用 BeforeSave-AfterSave 一对事件。像这样的：

Option Explicit

Private m_appFileFormat As XlFileFormat

'Utility for avoiding unwanted changes while trying to edit the actual template
Private Function IsTemplate() As Boolean
    IsTemplate = (Me.FileFormat = xlOpenXMLTemplateMacroEnabled)
End Function

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    If IsTemplate() Then Exit Sub
    If m_appFileFormat <> 0 Then
        Application.DefaultSaveFormat = m_appFileFormat
        m_appFileFormat = 0
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If IsTemplate() Then Exit Sub
    If SaveAsUI Then
        If m_appFileFormat = 0 Then m_appFileFormat = Application.DefaultSaveFormat
        Application.DefaultSaveFormat = xlOpenXMLAddIn
    End If
End Sub

Private Sub Workbook_Open()
    If IsTemplate() Then Exit Sub
    If Not Me.IsAddin Then Me.IsAddin = True
End Sub

关闭 Excel

用户可能会单击 Excel 关闭按钮。这就是您的问题实际指向的地方。

解决这个问题的一种方法是从BeforeClose 事件中更改Application.DefaultSaveFormat，这很好地解决了我们现在需要一种方法来恢复应用程序格式的缺点。更糟糕的是，用户可能会按下取消或不保存。

不幸的是，没有事件表明应用程序正在关闭或关闭已取消。我唯一能想到的就是捕获状态损失。为此，您可以使用自己的 subclassProc 方法，但这需要太多样板文件。相反，我建议我们使用假对象并利用IUnknown::Release。

在标准的“bas”模块中添加以下代码：

Option Explicit

#If Mac Then
    Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr
#Else
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#End If

Private m_appFileFormat As XlFileFormat

Private Sub Release(ByVal instancePtr As LongPtr)
    'Do not press Reset while in this method as that will "nuke" the application
    If m_appFileFormat <> 0 Then Application.DefaultSaveFormat = m_appFileFormat
    m_appFileFormat = 0
End Sub

Private Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
    #If Win64 Then
        Const PTR_SIZE As Long = 8
    #Else
        Const PTR_SIZE As Long = 4
    #End If
    CopyMemory ByVal memAddress, newValue, PTR_SIZE
End Property

Public Sub RestoreAppFileFormatAtStateLoss(ByVal appFileFormat As XlFileFormat)
    If m_appFileFormat <> 0 Then Exit Sub
    
    Static o As Object
    Static vtbl(0 To 2) As LongPtr
    Static vtblPtr As LongPtr
    
    'We only need Release, QueryInterface and AddRef and not useful
    vtbl(2) = VBA.Int(AddressOf Release)
    
    'Point to vTable
    vtblPtr = VarPtr(vtbl(0))
    MemLongPtr(VarPtr(o)) = VarPtr(vtblPtr)
    
    m_appFileFormat = appFileFormat
End Sub

ThisWorkbook模块中的最终代码可以变成：

Option Explicit

Private m_appFileFormat As XlFileFormat

'Utility for avoiding unwanted changes while trying to edit the actual template
Private Function IsTemplate() As Boolean
    IsTemplate = (Me.FileFormat = xlOpenXMLTemplateMacroEnabled)
End Function

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    If IsTemplate() Then Exit Sub
    If m_appFileFormat <> 0 Then
        Application.DefaultSaveFormat = m_appFileFormat
        m_appFileFormat = 0
    End If
End Sub

Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
    If IsTemplate() Then Exit Sub
    If Me.Saved Then Exit Sub
    
    If Me.Path = vbNullString Then
        RestoreAppFileFormatAtStateLoss Application.DefaultSaveFormat
        Application.DefaultSaveFormat = xlOpenXMLAddIn
    Else
        Select Case MsgBox("Wanna save before you quit?", vbQuestion + vbYesNoCancel, "Unsaved Changes")
        Case VbMsgBoxResult.vbYes
            Me.Save
        Case VbMsgBoxResult.vbCancel
            Cancel = True
        End Select
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If IsTemplate() Then Exit Sub
    If SaveAsUI Then
        If m_appFileFormat = 0 Then m_appFileFormat = Application.DefaultSaveFormat
        Application.DefaultSaveFormat = xlOpenXMLAddIn
    End If
End Sub

Private Sub Workbook_Open()
    If IsTemplate() Then Exit Sub
    If Not Me.IsAddin Then Me.IsAddin = True
End Sub

我已经测试了几个场景，似乎Application.DefaultSaveFormat 已正确恢复。如有遗漏，敬请见谅。