Question

我有工作代码复制文件中的单元格并粘贴到使用VBA代码生成的新创建的文档中。我希望另存为这个新创建的文档，这是目前能够做到的。我创建了一个csPath变量来尝试将文档的位置指定为“另存为”，但它只会保存在我的桌面上或遇到错误。有什么建议吗？

'Declaring variables for the Save As function  
Dim fname As Variant            ' Required for declaring the document name
Dim NewWb As Workbook           ' Specifies the new workbook for the Save As function
Dim FileFormatValue As Long     ' Allows programmer to declare what file formats that can be in the Save As function, currently only .xlsx
Dim csPath As String            ' Allows program to set location for Save As function

'Begin the Save As function for easy operator reference of old batches

csPath = "\\346nafp1\shares$\Departments\Starch\Wetend\Transfer\old - dont touch\"

' Check the Excel version
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then

    ' Only choice in the "Save as type" dropdown is Excel files(xls)
    ' if the Excel version is 2000-2003
    fname = Application.GetSaveAsFilename(InitialFileName:="", _
    Filefilter:="Excel Files (*.xls), *.xls", _
    Title:="This example copies the ActiveSheet to a new workbook")

    If fname <> False Then
        ' Copy the ActiveSheet to new workbook
        ActiveSheet.Copy
        Set NewWb = ActiveWorkbook

        ' We use the 2000-2003 format xlWorkbookNormal here to save as xls
        NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
        NewWb.Close False
        Set NewWb = Nothing

    End If
Else
    ' Force to save as .xls for archiving in the History folder
    ' Files available there for use in the future for reference
    ' But disable macros to prevent changing or confusion when looking at archives

    fname = Application.GetSaveAsFilename(InitialFileName:=Worksheets("Oxy1").Cells(4, 7) & " " & Worksheets("Oxy1").Cells(4, 11), _
        Filefilter:= _
        " Excel Macro Free Workbook (*.xls), *.xls,", _
        FilterIndex:=2, Title:="Save and archive for new batch")

        ' Add the code to the Filefilter above if additional formats are needed
        ' Include " before the word Excel to add it in
        ' Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
        ' Excel 2000-2003 Workbook (*.xls), *.xls," & _
        ' Excel Binary Workbook (*.xlsb), *.xlsb", _

    ' Find the correct FileFormat that match the choice in the "Save as type" list
    If fname <> False Then
        Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
        Case "xls": FileFormatValue = 56
        Case "xlsx": FileFormatValue = 51
        Case "xlsm": FileFormatValue = 52
        Case "xlsb": FileFormatValue = 50
        Case Else: FileFormatValue = 0
        End Select

        ' Now we can create/Save the file with the xlFileFormat parameter
        ' value that match the file extension
        If FileFormatValue = 0 Then
            MsgBox "Sorry, unknown file extension"
        Else
            ' Copies the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'Save the file in the format you choose in the "Save as type" dropdown
            NewWb.SaveAs fname, FileFormat:= _
                         FileFormatValue, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    End If
End If

Answer 1

使用文件名：= argument。

在saveas中定义它

注意：不确定是否要保存到UNC \ share。

NewWb.SaveAs filename:="C:\Temp\NewFilename.xls", FileFormat:=56, CreateBackup:=False

或使用您的变量

NewWb.SaveAs filename:=csPath & "\NewFilename.xls", FileFormat:=56, CreateBackup:=False

此处还有一些关于fileformat arg的信息。不确定FileFormat:=-4143正在尝试做什么。

这些是Excel 2007-2016中的主要文件格式，注意：在Excel for Mac中，值为+1

51 = xlOpenXMLWorkbook（2007 - 2013年没有宏，xlsx）
  52 = xlOpenXMLWorkbookMacroEnabled（在2007-2013中有或没有宏＆x; s，xlsm）
  50 = xlExcel12（带有或的2007-2013 Excel二进制工作簿）    没有宏观，xlsb）
  56 = xlExcel8（Excel中为97-2003格式   2007-2013，xls）

使用excel VBA另存为特定位置

1 个答案: