Question

我有一个由多个用户访问的主文件，每月用作模板。我使用以下代码来允许某人另存为，但保存模板。如果在文件名中找不到“模板”，我也无法运行，因此可以根据需要重新打开和编辑已保存的副本。这是代码：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim strOrigFile As String
    strOrigFile = ActiveWorkbook.FullName
    Dim strNamePath As String
    Dim strWorkOrNot As Integer

    strWorkOrNot = InStr(1, strOrigFile, "Template")
    If strWorkOrNot = 0 Then GoTo AbortProcess

    If SaveAsUI Then
        Cancel = True
        strNamePath = Application.GetSaveAsFilename

        Select Case strNamePath
        Case "False"
        Case strOrigFile
            MsgBox "It may be a bad idea to save over the template. You should use Save-As and create a new file.", vbCritical, "Avoid Corrupting the Template!"
        Case Else
            Application.EnableEvents = 0
            Me.SaveAs strNamePath
            Application.EnableEvents = 1
        End Select
    Else
        If ThisWorkbook.Path & "\" & ThisWorkbook.Name = strOrigFile Then
            Cancel = True
            MsgBox "It may be a bad idea to save over the template. You should use Save-As and create a new file.", vbCritical, "Avoid Corrupting the Template!"
        End If
    End If

AbortProcess:

End Sub

当用户执行另存为时，对话框不会提供任何文件类型选项，如果有人在保存期间未指定，则会创建一个缺少扩展名的文件。 / p>

如何调整此代码以防止“另存为”对话框删除文件类型选项？出于好奇，为什么要这样做？

[解决]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim strOrigFile As String
    strOrigFile = ActiveWorkbook.FullName
    Dim strNamePath As String
    Dim strWorkOrNot As Integer

    strWorkOrNot = InStr(1, strOrigFile, "Template")
    If strWorkOrNot = 0 Then GoTo AbortProcess
    On Error GoTo SaveAsMacroWarning

    If SaveAsUI Then
        Cancel = True
        With Application.FileDialog(msoFileDialogSaveAs)
            .AllowMultiSelect = False
            .InitialFileName = "New"
            .Show
            If "False" Then
                Cancel = True
                Exit Sub
            Else
                strNamePath = .SelectedItems(1)
            End If
        End With

        Select Case strNamePath
        Case strOrigFile
            MsgBox "It may be a bad idea to save over the template. You should use Save-As and create a new file.", vbCritical, "Avoid Corrupting the Template!"
        Case Else
            Application.EnableEvents = 0
            Me.SaveAs Filename:=strNamePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.EnableEvents = 1
        End Select
    Else
        If ThisWorkbook.Path & "\" & ThisWorkbook.Name = strOrigFile Then
            Cancel = True
            MsgBox "It may be a bad idea to save over the template. You should use Save-As and create a new file.", vbCritical, "Avoid Corrupting the Template!"
        End If
    End If

SaveAsMacroWarning:

    MsgBox "You'll need to save it as a Macro-Enabled file type.", vbCritical, "Save as Macro-Enabled"

AbortProcess:

End Sub

Answer 1

缺少默认文件类型是由Application引起的。 GetSaveAsFilename （）

尝试使用Application。 FileDialog（msoFileDialogSaveAs）：

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim fId As String, oldName As String, iniName As String, fn As String

    If SaveAsUI Then
        Cancel = True
        fId = " - " & Format(Now, "yyyy-mm-dd hh-mm-ss")
        oldName = ActiveWorkbook.Name
        oldName = Left(oldName, InStrRev(oldName, ".") - 1)
        iniName = Replace(ActiveWorkbook.FullName, oldName, oldName & fId)

        With Application.FileDialog(msoFileDialogSaveAs)
            .AllowMultiSelect = False
            .InitialFileName = iniName
            .Show
            If .SelectedItems.Count = 1 Then
                fn = .SelectedItems(1)
                fn = Right(fn, Len(fn) - InStrRev(fn, "\"))
                fn = Left(fn, InStrRev(fn, ".") - 1)
                If fn = oldName Then fn = Replace(.SelectedItems(1), fn, fn & fId)

                Application.EnableEvents = False
                Application.DisplayAlerts = False
                Me.SaveAs fn
                Application.DisplayAlerts = True
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub

Workbook_BeforeSave在“另存为”对话框中删除了文件类型

1 个答案: