VBA 仅在"Save"上运行，但不在"Save As"上运行

Question

我想将excel工作簿的名称导入到特定的单元格集。函数Display_File_Name完成了这个任务。

下面的代码工作时，我做保存(Ctrl+S)，但它不工作时，我做另存为。我没有看到文件名在单元格中更新。该功能如何运行，即使用户选择做另存为?

我目前的解决方案是使用Workbook_BeforeClose或Workbook_AfterSave，但这将提示保存操作，我想避免。

你能帮我一下吗?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Display_File_Name

End Sub
Function Display_File_Name()
'Import filename
Set OpenBook = ActiveWorkbook

Filename = OpenBook.Name
'Record filename on Print page
OpenBook.Worksheets(4).Range("A2") = Filename
'Find the last row with values
LR= OpenBook.Worksheets(6).Columns("B").Find("*", _
SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
'Record filename
OpenBook.Worksheets(6).Range("A2:A" & LR) = Filename
End Function

参考使用:

ForWorkbook_BeforeSave: Link Link

ForWorkbook_BeforeClose: Link

Answer 1

保存前更新工作簿

提示

• Option Explicit强制声明所有变量。阅读它的好处。

• 不推荐使用Call关键字。真的没有什么用。

• DisplayFileName是VBA中首选的变量和过程命名约定。Display_File_Name是为Classes保留的。

• 要引用包含此代码的工作簿，可以在ThisWorkbook模块中使用Me关键字。在其他任何地方，你都可以使用ThisWorkbook

• 虽然使用Function工作，你的过程应该使用Sub，因为它只有。它不返回任何类似函数的东西都可以。考虑下面的简单示例:

  ' Returns the upper-case version of a string. 
  Function GetUCase(ByVal S As String) As String
  GetUCase = UCase(S)
  End Function
  

  可以这样使用:

  Sub Test() ' Prints a string and its upper-case version. 
  Const sOld As String = "small"
  Dim sNew As String: sNew = GetUCase(sOld)
  Debug.Print sOld & ", " & sNew ' prints 'small, SMALL'
  End Sub
  

• 虽然您可以"借用"VBA的一些关键字，但最好避免这样做。您在Filename中使用了完全相同的大小写，这是SaveAs或SaveCopyAs方法的第一个参数名称，但它与变量命名约定(FileName)相冲突。

• 为了避免一些意外(不是在这种情况下)，我更喜欢使用Value当写入值到一个范围，例如ws.Range("A1").Value = 1。

• 在Find方法中，当您在一列中搜索时，您不必要地使用SearchOrder参数。如果存在隐藏的单元格(行或列)，LookIn参数的xlValues参数将失败，因此我更喜欢xlFormulas参数来查找包含任何内容的单元格，这也将找到包含公式计算为""的单元格。如果代码中的Find方法没有找到单元格，则会发生错误。请参阅下面的代码如何避免这种情况。

• 我还没有固定使用索引引用工作表，因为我不知道工作表的名称，但你应该绝对放弃引用工作表的这种方式。

  • 当使用索引时，例如Set ws = wb.Worksheets(1)，用户可以将选项卡移动到另一个位置，您的代码将失败。
  • 不太可能，当使用工作表名称时，例如Set ws = wb.Worksheets("Sheet1")，用户可以重命名工作表，并且再次，代码将失败。
  • 最不可能的是，如果您使用代码名称，例如Set ws = Sheet1或仅使用Sheet1而不是变量，用户可以重命名代码名称，代码将失败。

代码

标准模块，例如Module1

• 或者，你可以把它留在ThisWorkbook模块。

Option Explicit
Sub DisplayFileName(ByVal wb As Workbook)

' Validate the workbook ('wb').
If wb Is Nothing Then Exit Sub

' Write the file name to a variable ('sFileName').
Dim sFileName As String: sFileName = wb.Name

' Create a reference to the Print worksheet ('pws').
Dim pws As Worksheet: Set pws = wb.Worksheets(4)
' Create a reference to the Print cell ('pCell').
Dim pCell As Range: Set pCell = pws.Range("A2")
' Write the file name to the Print cell.
pCell.Value = sFileName
' Autofit Print column.
'pCell.EntireColumn.AutoFit

' Create a reference to the Destination worksheet ('dws').
Dim dws As Worksheet: Set dws = wb.Worksheets(6)

' Create a reference to the Destination last cell ('dlCell') in column 'B'.
Dim dlCell As Range
Set dlCell = dws.Columns("B").Find("*", , xlFormulas, , , xlPrevious)
' Validate Destination last cell.
If dlCell Is Nothing Then Exit Sub ' empty 'B' column

' Write the last row to a variable ('dlRow').
Dim dlRow As Long: dlRow = dlCell.Row
' Validate the last row.
If dlRow < 2 Then Exit Sub ' the last row cannot be 1 because of '"A2:A"'.

' Create a reference to the Destination range ('drg') in column 'A'.
Dim drg As Range: Set drg = dws.Range("A2:A" & dlRow)
' Write the file name to the cells of the Destination range.
drg.Value = sFileName
' Autofit Destination column.
'drg.EntireColumn.AutoFit
End Sub

ThisWorkbookmodule

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
DisplayFileName Me
End Sub