GetSaveAsFilename 使用单元格值作为文件标题

Question

请帮助！我正在使用“GetSaveAsFilname”函数使用特定单元格的值作为标题来保存我的文件，这是通过公式创建的。我不是唯一一个使用该文件的人，所以保存路径大多由用户选择。大多数情况下它可以工作，但有时标题是空白的，用户需要从零开始写下来。在我的代码下方：

Sub SaveTool()

Dim Name As String
Dim sFileSaveName As Variant

Name = ActiveWorkbook.Sheets("Analisis").Range("G1")
sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=Name, FileFilter:="Excel Files (*.xlsm), *.xlsm")

If sFileSaveName <> False Then
    ActiveWorkbook.SaveAs sFileSaveName
End If

End Sub

Answer 1

如果建议的名称为空，则问题出在设置为 Name 的 InitialFileName 上。所以问题是 Name 有时是空白的。 Name 从 ActiveWorkbook.Sheets("Analisis").Range("G1") 获取它的值。

其中两个不可靠的部分是：

ActiveWorkbook 而不是 ThisWorkbook 或 Application.Workbooks(index)。如果用户在执行宏之前单击其他工作簿，则 ActiveWorkbook 可能指向不相关的工作簿。
Sheets("Analisis").Range("G1") 开放供用户编辑。如果 sheet 未受到保护，则用户可能无意中删除了该单元格中包含的文本。

我建议用一行检查 Name 是否为空，并在确实为空的情况下为 Name 提供默认值。

Sub SaveTool()

Dim Name As String
Dim sFileSaveName As Variant

Name = ActiveWorkbook.Sheets("Analisis").Range("G1")

If Trim(Name) = "" Then Name = "DefaultFileName"

sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=Name, FileFilter:="Excel Files (*.xlsm), *.xlsm")

If sFileSaveName <> False Then
    ActiveWorkbook.SaveAs sFileSaveName
End If

End Sub

我添加了一个测试，也许可以帮助您调试为什么这似乎对您和您的文件不起作用：

打开一个空白工作簿并尝试此代码 - 在弹出窗口中按“保存”windows，无需输入任何内容：

Sub test()
    With ThisWorkbook.Sheets.Add
        .Name = "Analisis"
        .Range("G1").Value = "Test_File_Name"
    End With
    
    Dim Name As String
    Dim sFileSaveName As Variant
    
    Name = "Test_File_Name"
    Debug.Print "1a - " & Name
    sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=Name, FileFilter:="Excel Files (*.xlsm), *.xlsm")
    Debug.Print "1b - " & sFileSaveName
    
    Name = ThisWorkbook.Sheets("Analisis").Range("G1").Value
    Debug.Print "2a - " & Name
    sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=Name, FileFilter:="Excel Files (*.xlsm), *.xlsm")
    Debug.Print "2b - " & sFileSaveName
End Sub

输出应该是：

'1a - Test_File_Name
'1b - C:\Users\Username\Documents\Test_File_Name.xlsm
'2a - Test_File_Name
'2b - C:\Users\Username\Documents\Test_File_Name.xlsm

现在从测试中删除 With 块并将代码放入项目文件中。输出的差异应该可以帮助您缩小问题的原因。

Answer 2

问题所在名字上的特殊字符要赋值！我添加了一个函数来删除带有空格的它们，现在它可以工作了！这是最终代码：

Function ValidFileName(text As String) As String
    text = Replace(text, "\", "")
    text = Replace(text, "/", "")
    text = Replace(text, "[", "")
    text = Replace(text, "]", "")
    text = Replace(text, ":", "")
    text = Replace(text, "?", "")
    text = Replace(text, ".", "")
    text = Replace(text, ",", "")
        ValidFileName = text
End Function
Sub SaveTool()

Dim ToolName As String
Dim sFileSaveName As Variant


ToolName = ValidFileName(ThisWorkbook.Sheets("Analisis").Range("G1").Value)

sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=ToolName, FileFilter:="Excel Files (*.xlsm), *.xlsm")

If sFileSaveName <> False Then
    ActiveWorkbook.SaveAs sFileSaveName
End If

End Sub

感谢@Toddleson 的帮助！

GetSaveAsFilename 使用单元格值作为文件标题

GetSaveAsFilename using a cell value as file title

excel

vba

save-as