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

时间:2018-01-08 15:11:50

标签: excel vba

我试图将我的“另存为”路径打开为打开原始文档的同一文件夹。例如,如果文件是公共/表单,我希望它提示保存为public / forms。目前它默认为mypc / documents。这是我的代码:

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

谢谢!

3 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

假设InitialName仅包含没有路径的文件名,请将参数InitialFileName更改为

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

答案 2 :(得分:0)

我认为这就是你想要的:

文件过滤器可以在初始路径中获取完整文件夹,因此您可以根据工作簿路径分配它

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")