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

Question

我一直在尝试一些代码，none 似乎有效。下面的代码是我发现的最接近我想要实现的代码，但仍然有些不对劲。

我想将一个 sheet "consolidated" 移动到一个新工作簿并将该工作簿另存为预填充的文件名 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

Answer 1

你可以试试：

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

Answer 2

由于.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

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

VBA code for saving worksheet as a prenamed file in the saveas dialogue box

excel

vba

worksheet

save