excel - 根据 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 范围内可用因为那是你打开和关闭它的地方。因此，您有 2 个选择:

在退出 CopySheetFromClosedWorkbook2 范围之前保存主工作簿方法，即当源书的名称可用时

将源书的名称保存在某处(全局变量、命名范围、注册表、自定义 xml 部分等)，甚至将其作为结果返回(Function 而不是 Sub)，以便您可以调用 SaveNoMacro后期方法

退出范围前保存
这里有两种方法可以做到这一点:

将您的保存代码放在 src.Close False 之前行，以便您可以使用 src.Name属性，即将两种方法合二为一。不确定是否要这样做

将名称作为参数传递给第二种方法。在 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