我试图将我的“另存为”路径打开为打开原始文档的同一文件夹。例如,如果文件是公共/表单,我希望它提示保存为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
谢谢!
答案 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")