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

Question

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

提示选择外部工作簿
正在复制那个 wb 的所有数据
在主 wb1: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 相同的名称，并在末尾添加 date/time。

示例：

MainWB1.xlsm + ExternalWB1.xlsx >>> MainWB1.xlsx (这是现在)

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

Answer 1

fn = Replace(.FullName, ".xlsm", ".xlsx")



fn = Replace(.FullName, ".xlsm", date & ".xlsx")

Answer 2

您有两种不同的方法：

CopySheetFromClosedWorkbook2
SaveNoMacro

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

在退出 CopySheetFromClosedWorkbook2 方法的范围之前保存主工作簿，即当源书的名称可用时
将源书的名称保存在某处（全局变量、命名范围、注册表、自定义 xml 部分等），甚至 return 结果（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 个方法，那么您可以保存名称以备后用。使用全局变量不是一个好主意，因为在您运行保存方法时状态可能会丢失。只要您的工作簿没有受到保护，就可以使用命名范围，即您可以创建一个命名范围。

有很多选项，但最容易使用的是使用内置 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

Answer 3

我只需要（如果可能的话）将我的 wb 保存为与我从中获取数据的外部 wb 相同的名称，并在末尾添加 date/time

您在变量 FilePath 中获得了外部 wb 的完整路径，因此您可以使用它来保存工作簿。你可以像这样保存它（在你的子 CopySheetFromClosedWorkbook2 的末尾）：

Dim SaveName As String


SaveName = src.Path & "\" & Replace(Split(Filepath, "\")(UBound(Split(Filepath, "\"))), ".xlsm", Format(Date, "dd_mm_yyyy") & ".xlsx")


With ThisWorkbook
    Application.DisplayAlerts = False
    .SaveAs SaveName, FileFormat:=xlWorkbookDefault
    Application.DisplayAlerts = True
End With

请注意，我正在使用对象 src 来获取您要保存新工作簿的路径，因此您需要在执行 [=15= 之前的任何位置分配行 SaveName = .... ].

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

Save my WB based on another workbook name in VBA

excel

vba

excel-formula

退出范围前保存

保存名称以备后用