根据 VBA 中的另一个工作簿名称保存我的 WB

Question

我有一个代码正在执行以下操作：

• 提示选择外部工作簿

• 复制该 wb 中的所有数据

• 在主 wb 中精确粘贴 1:1

• 关闭并从 .xlsm 保存到 .xlsx，但名称为我的主 wb

    Sub CopySheetFromClosedWorkbook2()
  
    'Prompt to choose your file in the chosen locatioon
    Dim dialogBox As FileDialog
    Dim FilePath As String
    Set dialogBox = Application.FileDialog(msoFileDialogOpen)
    Application.StatusBar = "Choose older PDS Form!"
  
    dialogBox.AllowMultiSelect = False
    dialogBox.Title = "Select a file"
    If dialogBox.Show = -1 Then
        FilePath = dialogBox.SelectedItems(1)
  
    'If nothing selected then MsgBox
    Else
       MsgBox "No PDS Form selected!"
       Exit Sub
    End If
  
    'Here are sheets defined which you are going to copy/paste (reference update) but to keep formatting.
    ''Sheets should be defined from right to left to have your sheets sorted from the beginning
    Dim shNames As Variant: shNames = Array("CH_or_Recipe_8", "CH_or_Recipe_7", "CH_or_Recipe_6", "CH_or_Recipe_5", "CH_or_Recipe_4", _
    "CH_or_Recipe_3", "CH_or_Recipe_2", "CH_or_Recipe_1", "Customer Details", "Instructions")
  
    Dim tgt As Workbook: Set tgt = ThisWorkbook
    Application.ScreenUpdating = False
    Dim src As Workbook: Set src = Workbooks.Open(FilePath)
    Dim ws As Worksheet, rng As Range, i As Long
  
    For Each ws In src.Sheets
        If ws.Name Like "*[1-8]" Then
            ws.Name = "CH_or_Recipe_" & Right(ws.Name, 1)
        ElseIf ws.Name = "Customer_Details" Then
            ws.Name = "Customer Details"
        ElseIf ws.Name = "OIPT Plasmalab" Then
            ws.Name = "CH_or_Recipe_1"
        ElseIf ws.Name = "AMAT" Then
            ws.Name = "CH_or_Recipe_2"
  
        End If
    Next
  
    For i = 0 To UBound(shNames)
        On Error Resume Next
        Set ws = src.Sheets(shNames(i))
        If Err.Number = 0 Then
            tgt.Worksheets(shNames(i)).Cells.Clear
            Set rng = ws.UsedRange
            rng.Copy tgt.Worksheets(shNames(i)).Range(rng.Address)
        End If
    Next i
    src.Close False
  
    Application.ScreenUpdating = True
    MsgBox "Copy&Paste successful!"
    End Sub
  
  
    Sub SaveNoMacro()
  
    Dim fn As String
    With ThisWorkbook
        fn = Replace(.FullName, ".xlsm", ".xlsx")
         Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
         Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
  
   End Sub
  

我只需要（如果可能的话）是以与我从中获取数据并在末尾添加日期/时间的外部WB相同的名称保存我的WB。

例子：

MainWB1.xlsm +ExternalWB1.xlsx >>> MainWB1.xlsx（这是现在）

MainWB1.xlsm +ExternalWB1.xlsx >>>ExternalWB1_today().xlsx （这就是我想要的）

Answer 1

您有 2 种单独的方法：

• CopySheetFromClosedWorkbook2
• SaveNoMacro

源工作簿的名称仅在 的范围内可用，CopySheetFromClosedWorkbook2因为这是您打开和关闭它的位置。所以，你有两个选择：

1. 在退出范围之前保存主工作簿CopySheetFromClosedWorkbook2即当源书籍的名称可用时
2. 将源书的名称保存在某处（全局变量、命名范围、注册表、自定义 xml 部分等），甚至将其作为结果返回（Function而不是Sub），以便您可以SaveNoMacro在稍后阶段调用该方法

退出范围前保存

有两种方法可以做到这一点：

1. 将保存代码放在该src.Close False行之前，以便您可以使用该src.Name属性，即将两种方法合二为一。不确定您是否想这样做
2. 将名称作为参数传递给第二个方法。替换CopySheetFromClosedWorkbook2这个：

src.Close False

有了这个：

SaveNoMacro src.Name
src.Close False

并更新SaveNoMacro为：

Sub SaveNoMacro(ByVal newName As String)
    Dim fn As String
    With ThisWorkbook
        fn = Replace(.FullName, .Name, Left(newName, InStrRev(newName, ".") - 1)) _
           & Format$(Date, "_yyyy-mm-dd") & ".xlsx"
        Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
        Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
End Sub

保存名称以供以后使用

如果您不想按顺序运行这 2 个方法，则可以保存名称以供以后使用。使用全局变量不是一个好主意，因为运行 save 方法时状态可能会丢失。只要您的工作簿没有受到保护，就可以使用命名范围，即您可以创建命名范围。

有很多选项，但最容易使用的是使用内置SaveSetting选项写入注册表。替换这个：

src.Close False

有了这个：

SaveSetting "MyApp", "MySection", "NewBookName", src.Name
src.Close False

并更新SaveNoMacro为：

Sub SaveNoMacro()
    Dim fn As String: fn = GetSetting("MyApp", "MySection", "NewBookName")
    If LenB(fn) = 0 Then
        MsgBox "No name was saved", vbInformation, "Cancelled"
        Exit Sub
    Else
        DeleteSetting "MyApp", "MySection", "NewBookName"
    End If
    With ThisWorkbook
        fn = Replace(.FullName, .Name, Left(fn, InStrRev(fn, ".") - 1)) _
           & Format$(Date, "_yyyy-mm-dd") & ".xlsx"
        Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
        Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
End Sub