从加载项使用宏时保存活动工作簿

时间:2016-01-12 14:23:22

标签: excel vba excel-vba csv

我创建了一个宏,它将.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的名称=信息来自的文件的名称。并且能够在我打开的任何工作簿中执行此操作。

1 个答案:

答案 0 :(得分:3)

试试这段代码:

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

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