Сохранение активной рабочей книги при использовании макроса из надстройки

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 

добавить ws.name после awb.name, чтобы предотвратить такое же имя файла.