用于在另存为对话框中将工作表另存为预命名文件的 VBA 代码

Posted 2023-05-07

【中文标题】用于在另存为对话框中将工作表另存为预命名文件的 VBA 代码

【英文标题】：VBA code for saving worksheet as a prenamed file in the saveas dialogue box

【发布时间】：2018-07-10 14:10:43

【问题描述】：

我已经尝试了许多代码，但似乎没有一个有效。下面的代码是我发现的最接近我想要实现的代码，但仍有一些问题。

我想将“合并”工作表移动到新工作簿并将工作簿保存为预填充的文件名 Consolidated.xlsx。我希望弹出对话框，以便用户只需选择他们想要的文件夹。看起来代码按预期工作，但是当您单击保存时，它实际上并没有生成保存的文件。

非常感谢任何帮助。

谢谢

Sub Export()
Dim pathh As Variant

    ActiveWorkbook.Sheets("consolidated").Copy
    pathh = Application.GetSaveAsFilename( _
            FileFilter:="xlWorkbookDefault Files (*.xlsx), *.xlsx", _
            Title:="Consolidated", _
            InitialFileName:=filenamestring)
Application.DisplayAlerts = True
End Sub

另一种尝试保存文件，但没有显示保存位置的对话框：

Application.Goto ActiveWorkbook.Sheets("consolidated").Cells(1, 1)
ActiveSheet.Copy
ActiveWorkbook.SaveAs filename:=("Consolidated"), FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close savechanges:=False

【问题讨论】：

GetSaveAsFilename 不保存文件，它只是让用户选择一个文件名。你必须有代码来保存文件。

看msdn.microsoft.com/en-us/VBA/Excel-VBA/articles/…

@VincentG 我更新了另一个版本的代码，它完成了所有工作，但允许用户选择保存文件的位置的对话框。你能帮忙写第二行代码吗？

不要使用复制，并使用工作表中的另存为，而不是工作簿。

不适合我@VincentG

【参考方案1】：

由于.SaveAs与当前文件混淆，我尽量不使用它。

这或多或少是我用来创建模板文件的，但被修改为创建常规文件。

Public Sub CreateTemplate(Sheet As Excel.Worksheet, TemplateFile As String)
Dim SaveFormat As Long, SheetsInNewWorkbook As Long
Dim oBook As Excel.Workbook
Dim FileFormat As Integer

    ' Delete the old file, if it exists (to avoid the possible overwrite prompt later)
    On Error Resume Next
    Kill (TemplateFile)
    On Error GoTo 0

    'Remember the user's setting
    SaveFormat = Application.DefaultSaveFormat
    SheetsInNewWorkbook = Application.SheetsInNewWorkbook

    ' Change the DefaultSaveFormat, which controls the format when creating a new workbook.
    'Set the file format to the new 2007+ (.xlsx) format (with 1048576 rows), with 1 sheet
    Application.DefaultSaveFormat = xlOpenXMLWorkbook   '51
    Application.SheetsInNewWorkbook = 1
    'If you want the old 97-2003 (.xls) format (65536 rows), use
    'Application.DefaultSaveFormat = xlWorkbookNormal    '-4143

    ' Create a new Workbook
    Set oBook = Application.Workbooks.Add

    'Set DefaultSaveFormat & SheetsInNewWorkbook back to the user's settings
    Application.DefaultSaveFormat = SaveFormat
    Application.SheetsInNewWorkbook = SheetsInNewWorkbook

    ' Copy the sheet to the new Workbook
    Sheet.Copy After:=oBook.Sheets(1)
    ' Make sure the sheet is Visible (since my templates are hidden sheets)
    oBook.Sheets(2).Visible = True
    ' Supress the prompt to delete the blank Sheet(1)
    Application.DisplayAlerts = False
    oBook.Sheets(1).Delete

    ' Set the save format...
    FileFormat = xlOpenXMLWorkbook   '51
    ' For templates, use
    'FileFormat = xlTemplate    '17

    ' Save the file
    oBook.SaveAs Filename:=TemplateFile, FileFormat:=FileFormat, ReadOnlyRecommended:=False, CreateBackup:=False

    ' Return the prompts to normal
    Application.DisplayAlerts = True
    ' Close the Workbook, and clear the memory
    oBook.Close
    Set oBook = Nothing
End Sub

你可以这么简单，像这样：

CreateTemplate ActiveSheet, pathh

【参考方案2】：

你可以试试：

Sub Export()
    Dim pathh As Variant

    pathh = Application.GetSaveAsFilename( _
        FileFilter:="xlWorkbookDefault Files (*.xlsx), *.xlsx", _
        Title:="Consolidated", _
        InitialFileName:="Consolidated.xlsx")
    If pathh <> False then
        ActiveWorkbook.Sheets("consolidated").Copy
        ActiveWorkbook.Close Filename:=pathh
    End If
End Sub

【讨论】：

打开的对话框，我点击保存。然后它会打开另一个对话框，询问我是否要使用文件名 book13 保存。没有按预期工作。复制它的方法是，将工作表命名为合并到一个新工作簿中，运行代码时您会明白我的意思。