Question

我使用下面的代码，因此用户可以＆＃34;导出＆＃34;他们正在努力的工作手册。基本上，他们在只读主工作簿中工作，当他们点击下面的子工作时，它会执行一个SaveAs到用户选择的文件夹中的文件名：Sheets（＆＃34; Master＆＃34 ;）范围（＆＃34; B5＆＃34）

这很好用，唯一的问题是，如果有一个＆＃39; .xlsm＆＃39;文件在用户选择的文件夹中，然后单击它以获取文件名，保存的工作簿名称变为＆＃34; XXXXXX.xlsm.xlsm＆＃34;。如果用户没有点击任何内容并点击保存则可以正常工作。

有什么想法吗？如果这不清楚，请告诉我

Sub ExportTrip()
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFile As String

Application.ScreenUpdating = False    ' Prevents screen refreshing.

CurrentFile = ThisWorkbook.FullName

NewFile = Application.GetSaveAsFilename( _
    InitialFileName:=Sheets("Master").Range("B5"))

If NewFile <> "" And NewFile <> "False" Then
    ActiveWorkbook.SaveAs filename:=NewFile & "xlsm", _
        FileFormat:=52, _
        Password:="", _
        WriteResPassword:="", _
        ReadOnlyRecommended:=False, _
        CreateBackup:=False

    Set ActBook = ActiveWorkbook
    Workbooks.Open CurrentFile
Application.DisplayAlerts = False
    ActBook.Close
Application.DisplayAlerts = True
End If

Application.ScreenUpdating = True
End Sub

Answer 1

想出来，需要添加文件过滤器。见下文：

Sub ExportTrip()
    Dim ActSheet As Worksheet
    Dim ActBook As Workbook
    Dim CurrentFile As String
    Dim NewFile As String

    Application.ScreenUpdating = False    ' Prevents screen refreshing.

    CurrentFile = ThisWorkbook.FullName   ' saves filename of current workbook

    NewFile = Application.GetSaveAsFilename( _
        InitialFileName:=Sheets("Master").Range("B5"), _
        FileFilter:="ARMS Export *.xlsm (*.xlsm),")   ' gets filename for exported workbook

       If NewFile <> "" And NewFile <> "False" Then         'if user doesn't pick name
        ActiveWorkbook.SaveAs filename:=NewFile, _
            FileFormat:=52, _
            Password:="", _
            WriteResPassword:="", _
            ReadOnlyRecommended:=False, _
            CreateBackup:=False

        Set ActBook = ActiveWorkbook 'declares variable for open workbook
        Workbooks.Open CurrentFile   'reopens original workbook
    Application.DisplayAlerts = False
        ActBook.Close                'closes exported workbook
    Application.DisplayAlerts = True
    End If

    Application.ScreenUpdating = True
End Sub

SaveAs有效，除非用户在SaveAsDialog中选择文件

1 个答案: