Question

我对此代码有一个奇怪的错误。该代码强制用户将文件保存在特定文件名下。这是有效的，但是第一次按保存时，文件没有保存！但是，当我第二次按下保存时，它可以工作！

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
    Dim strName As String
    Dim lFind As Long
    Dim NewName As String
    Dim NamePath As String

   If SaveAsUI = True Then

       cancel = True
       With Application

            .EnableEvents = False
            NamePath = .GetSaveAsFilename
            strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256)
            NamePath = Left(NamePath, InStrRev(NamePath, "\"))

            If NamePath = "False" Then
                .EnableEvents = True
                Exit Sub
            ElseIf Left(strName, 6) <> "MCFR25" Or strName = "MCFR25 Template.xlsm" Then
                NewName = InputBox("The filename """ & strName & """ is incorrect" & vbNewLine & _
                           "The filename either does not start with MCFR25 or is MCFR25 Template.xlsm" & vbNewLine & vbNewLine & vbNewLine & _
                            "Please input a name below starting with MCFR25" & vbNewLine & _
                            "For instance, MCFR25 xyz" & vbNewLine & _
                            "Do not include any extension, i.e., .xlsm", "Rename", "MCFR25")
                If NewName = vbNullString Then
                    Exit Sub
                End If
                If Left(NewName, 6) = "MCFR25" Then
                    strName = NewName & ".xlsm"
                End If

                Me.SaveAs NamePath & strName
               .EnableEvents = True

            End If
        End With

    End If
End Sub

Answer 1

如果文件名错误，您只能保存文件。您需要添加这样的其他内容，以便在名称正确时保存文件。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
    Dim strName As String
    Dim lFind As Long
    Dim NewName As String
    Dim NamePath As String

   If SaveAsUI = True Then

       cancel = True
       With Application

            .EnableEvents = False
            NamePath = .GetSaveAsFilename
            strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256)
            NamePath = Left(NamePath, InStrRev(NamePath, "\"))

            If NamePath = "False" Then
                .EnableEvents = True
                Exit Sub
            ElseIf Left(strName, 6) <> "MCFR25" Or strName = "MCFR25 Template.xlsm" Then
                NewName = InputBox("The filename """ & strName & """ is incorrect" & vbNewLine & _
                           "The filename either does not start with MCFR25 or is MCFR25 Template.xlsm" & vbNewLine & vbNewLine & vbNewLine & _
                            "Please input a name below starting with MCFR25" & vbNewLine & _
                            "For instance, MCFR25 xyz" & vbNewLine & _
                            "Do not include any extension, i.e., .xlsm", "Rename", "MCFR25")
                If NewName = vbNullString Then
                    Exit Sub
                End If
                If Left(NewName, 6) = "MCFR25" Then
                    strName = NewName & ".xlsm"
                End If

                Me.SaveAs NamePath & strName
               .EnableEvents = True
            Else
                 Me.SaveAs NamePath & strName
                 .EnableEvents = True
            End If
        End With

    End If
End Sub

Answer 2

尝试将格式强制为.xlsm

Me.SaveAs NamePath & strName, FileFormat:=52

强制用户保存为某个文件名，奇怪的错误

2 个答案: