如何通过引用两个单元格自动命名电子表格？

Question

我刚刚编写了一个spiffy宏来自动生成报告.它运行良好,但我需要它根据两个单元格中的数据自动命名电子表格.

本质上,此宏创建一个新的电子表格,将信息复制到它,并创建每月所需的相关数据透视表.

作为其中的一部分,我创建了一个仪表板,用于生成包含说明和报告所涉及的日期范围的报告.它目前创建电子表格" NEW REPORT ".有没有办法创建新的电子表格并自动命名为"Report 01.01.15 to 01.02.15"？

我将日期范围作为两个单独的单元格,我知道我必须确保日期范围是使用允许的字符(IE 01.01.15而不是01/01/15) - 我是是说有一种方法告诉用户他们用错误的分隔符输入日期？

Answer 1

Option Explicit 
Sub SaveAs() 

    Dim FileName    As String 
    Dim FilePath    As String
    Dim FName       As String 

    FilePath = "C:\Temp" 
    FileName = Sheets("Sheet1").Range("A1").Text
    FName = Sheets("Sheet1").Range("B1").Text
    ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & FName

End Sub 

要在今天的日期保存它

Dim sSave       As String
sSave = "Reports " & Format(Date, "dd-mm-yyyy")

或者明天的日期

"Reports" & Format(Date + 1, "dd-mm-yyyy")

对于文件格式参见示例

ThisWorkbook.SaveAs Filename:=FilePath, fileformat:=52 

这些是Excel 2007-2013中的主要文件格式

51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)

*Or maybe you want to save the one worksheet workbook to csv, txt or prn.*

".csv": FileFormatNum = 6
".txt": FileFormatNum = -4158
".prn": FileFormatNum = 36

要仅将一个工作表另存为新工作簿,则需要在保存工作表之前复制工作表

Option Explicit
Sub SaveAs()
    Dim Sht As Worksheet
    Dim FileName As String
    Dim FilePath As String

    FilePath = "C:\Temp"
    FileName = Sheets("Sheet1").Range("A1").Text

    Set Sht = ActiveWorkbook.Sheets("Sheet1")

    Sht.Copy

    ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName

End Sub

要将多个工作表另存为新工作簿,请使用 Sheets(Array("Sheet1", "Sheet2")).Copy

Option Explicit
Sub SaveAs()
    Dim Sht As Worksheet
    Dim Book As Workbook
    Dim FileName As String
    Dim FilePath As String

    FilePath = "C:\Temp"
    FileName = Sheets("Sheet1").Range("A1").Text

    Set Book = ActiveWorkbook

    With Book
        .Sheets(Array("Sheet1", "Sheet2")).Copy
    End With

    ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName

End Sub