excel - 导出具有动态名称范围的数组中的工作表

Question

Dim mySheets As Variant
Dim sh As Worksheet
Dim I As Long
Dim FileName As String
Dim strdate As Variant
Dim strSName As Variant

strSName = ActiveSheet.name
strdate = Format(Now, "dd-mm-yy")
mySheets = Array("1.output", "2.output", "3.output", "4.output")
For I = 0 To UBound(mySheets)

Set sh = ThisWorkbook.Sheets(mySheets(I))
sh.Select
FileName = Application.GetSaveAsFilename(InitialFileName:=strsname & strdate, FileFilter:="Excel Files (*.csv), *.csv")
If FileName = "False" Then
    MsgBox "Filename required", vbExclamation
Else
    ActiveSheet.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:=FileName, FileFormat:=xlCSV
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
End If
Next

End Sub

此代码存在问题，导致对话框不显示工作表名称。有什么建议吗？我认为 strsname 有问题。

标签： excelvba

Answer 1

将工作表备份到 CSV

• Application.GetSaveAsFilename需要文件扩展名 ( & ".csv")。
• 这是我写它的方式：

Option Explicit

Sub backupWorksheetsToCSV()
    
    Const wsNamesList As String = "1.output,2.output,3.output,4.output"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim wsNames() As String: wsNames = Split(wsNamesList, ",")
    Dim DatePattern As String: DatePattern = Format(Date, "dd-mm-yy")
    
    Dim ws As Worksheet
    Dim n As Long
    Dim iName As String
    Dim fName As String
    
    For n = 0 To UBound(wsNames)
        Set ws = wb.Worksheets(wsNames(n))
        iName = wb.Path & "\" & wsNames(n) & DatePattern & ".csv"
        fName = Application.GetSaveAsFilename( _
            FileFilter:="Excel Files (*.csv), *.csv", _
            InitialFileName:=iName)
        If fName = "False" Then
            MsgBox "Filename required", vbExclamation
        Else
            ws.Copy
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs FileName:=fName, FileFormat:=xlCSV
            ActiveWorkbook.Close SaveChanges:=False
            Application.DisplayAlerts = True
        End If
    Next

End Sub