vba - 使用加载项中的宏时保存事件工作簿

Question

我创建了一个宏，用于将 .xlsx 文件的值保存到某个目录中的 csv 中，其中 csv 的名称 = 写入该文件的 Excel 文件的名称。

我希望这个宏在任何电子表格/工作簿中都可用，因此我将其保存并添加为加载项。

我认为我在使用 ActiveWorkbook 与 Thisworkbook 时遇到问题。

以下代码是原始代码，在不用作加载项时可以按预期工作:

Sub CSV()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat

SaveToDirectory = "C:\SomeDirectory\"
For Each WS In ThisWorkbook.Worksheets
    Sheets(WS.Name).Copy
    ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & ".csv", FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
    ThisWorkbook.Activate
Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = False
End Sub

但是，如果在加载项中使用该代码，则文件会使用加载项的名称保存。因此我更改了代码并使用了 ActiveWorkbook，但在保存时值似乎发生了更改。

Sub CSV2()

On Error GoTo error_handler
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

CurrentWorkbook = ActiveWorkbook.Name
CurrentFormat = ActiveWorkbook.FileFormat

SaveToDirectory = "C:\SomeDirectory\"
For Each WS In ActiveWorkbook.Worksheets
    Sheets(WS.Name).Copy
    ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & ".csv", FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
    ThisWorkbook.Activate
Next

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = False

error_handler:
    MsgBox Err.Description

End Sub

我想将 Excel 文件写入 csv。将该 CSV 保存在定义的目录中。 csv 的名称 = 信息来源的文件的名称。并且能够在我打开的任何工作簿中执行此操作。

Answer 1

试试这个代码:

Sub CSV2()

 On Error GoTo error_handler
  Dim aWB As Workbook
  Dim WS As Excel.Worksheet
  Dim SaveToDirectory As String

  Dim CurrentWorkbook As String
  Dim CurrentFormat As Long
  Set aWB = ActiveWorkbook
  CurrentWorkbook = aWB.Name
  CurrentFormat = aWB.FileFormat

  SaveToDirectory = "C:\SomeDirectory\"
  For Each WS In aWB.Worksheets
    WS.Copy
    ActiveWorkbook.SaveAs Filename:=SaveToDirectory & aWB.Name & "_" & WS.Name & ".csv", FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
    'ThisWorkbook.Activate
  Next

  Application.DisplayAlerts = False
  aWB.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
  Application.DisplayAlerts = False

Exit Sub
error_handler:
    MsgBox Err.Description

End Sub

我在 awb.name 之后添加 ws.name 以防止出现相同的文件名。