另存为原始表单位置的路径 - VBA

Question

我正在尝试让我的另存为路径打开为打开原始文档的同一文件夹。例如，如果文件在公共/表单中，我希望它提示另存为公共/表单。目前它默认为 mypc/文档。这是我的代码：

Dim IntialName As String
Dim fileSaveName As Variant

InitialName = Range("d1") & "_" & "#" & Range("l1") & "-" & "RW" & 
Range("q1")
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _
filefilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")

If fileSaveName = False Then
       Exit Sub
End If
If Not fileSaveName = False Then
    ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & 
fileSaveName
    Else
         On Error Resume Next
         If Err.Number = 1004 Then
         On Error GoTo 0
Else
    ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & 
       fileSaveName
End If
End If

谢谢！

Answer 1

下面的代码将保存到您使用的文件名。 我已经让它引用 Sheet1 上的范围，而不是执行代码时当前处于活动状态的任何工作表。 根据需要更改工作表名称。

它还将打开到包含代码的文件所在的文件夹(ThisWorkbook(。
根据需要将其更改为ActiveWorkbook或任何其他路径。

Sub Test1()
    Dim InitialName As String
    With ThisWorkbook.Worksheets("Sheet1")
        InitialName = .Range("D1") & "_" & "#" & .Range("L1") & "-" & "RW" & .Range("Q1")
        InitialName = ThisWorkbook.Path & "" & InitialName
    End With
    InitialName = Application.GetSaveAsFilename(InitialName, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
    If Not InitialName = "False" Then
        ThisWorkbook.SaveAs InitialName
    End If
End Sub

Answer 2

假设InitialName只包含一个没有路径的文件名，请将参数InitialFileName更改为

Application.GetSaveAsFilename(InitialFileName:= thisWorkbook.Path & "" & InitialName, ...

Answer 3

我认为这就是你想要的：

文件筛选器可以在初始路径中采用完整文件夹，因此您可以根据工作簿路径分配它

Dim InitialName As String
Dim fileSaveName As Variant
Dim FilePath, FileOnly, PathOnly As String
FilePath = ThisWorkbook.FullName
FileOnly = ThisWorkbook.Name
PathOnly = Left(FilePath, Len(FilePath) - Len(FileOnly))

InitialName = PathOnly & "" & Range("d1") & "_" & "#" & Range("l1") & "-" & "RW" & 
Range("q1")
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _
filefilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")

If fileSaveName = False Then
       Exit Sub
End If
If Not fileSaveName = False Then
    ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & fileSaveName
    Else
         On Error Resume Next
         If Err.Number = 1004 Then
         On Error GoTo 0
Else
    ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & fileSaveName
End If
End If
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _ 
   filefilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")