我一直在玩这个代码。理想情况下,我可以强制用户将文件名保存为从Lowpar开始,尽管我可以解决这个问题,因为代码无法正常工作。例如,我想调用文件Lowpar2016但是使用此代码它将无法工作。
.row
答案 0 :(得分:3)
以下重构代码会强制该名称以LowPar
开头,如果它还没有:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NamePath As String
Dim strName As String
Dim lFind As Long
If SaveAsUI = True Then ' unless this is set to <> true, it does not work
Cancel = True
With Application
.EnableEvents = False
NamePath = .GetSaveAsFilename
strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256)
If NamePath = "False" Then ' this is part of the code that confuses me
.EnableEvents = True
Exit Sub
ElseIf Left(strName, 6) <> "Lowpar" Then
NamePath = "LowPar_" & NamePath
End If
Me.SaveAs NamePath
.EnableEvents = True
End With
End If
End Sub
答案 1 :(得分:0)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
Dim NamePath As String
Dim strName As String
Dim lFind As Long
Dim NewName 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) <> "Name" Then
NewName = InputBox("The filename """ & strName & """ is incorrect" & vbNewLine & _
"Please input a name below starting with Name" & vbNewLine & _
"For instance, Name and other things" & vbNewLine & _
"Do not include any extension, i.e., .xlsm", "Rename", "Name")
If Left(NewName, 6) = "Name" Then
strName = NewName & ".xlsm"
End If
Me.SaveAs NamePath & strName
.EnableEvents = True
End If
End With
End If
End sub