Сохранить с определенным именем файла и форматом

Я хотел бы попросить вашей помощи с этим кодом:

Option Explicit
Private WithEvents App As Excel.Application

Private Sub Workbook_Open()
    Set App = Application
End Sub

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    App.EnableEvents = False
    With App.Dialogs(xlDialogSaveAs)
        Call .Show(MakeDocName, xlOpenXMLWorkbookMacroEnabled)
    End With
    App.EnableEvents = True
    Cancel = True
End Sub


Function MakeDocName() As String
    Dim theName As String
    Dim pName As String
    Dim pUName As String

    pName = Sheets("DESCRIPTION").Range("b4")
    pUName = UCase(pName)
    theName = pUName & " RN " & Sheets("DESCRIPTION").Range("b2")
    MakeDocName = theName
End Function

По сути, я ожидаю от этого кода возможности сохранить файл с указанным именем и форматом. Название берется непосредственно из листа «ОПИСАНИЕ». Формат должен быть .xlsm.

Проблема в том, что код работает не только внутри ThisWorkbook, но и во всех открытых файлах Excel.

Есть ли возможность сделать этот код доступным только для указанного файла, в который он включен?


excel vba save save-as
person Riccardo    schedule 19.11.2015    source источник
comment
Вы погружаете события приложения, сделайте это в рабочей книге, это может быть идеей. Private WithEvents WB As Excel.Workbook с использованием Private Sub WB_BeforeSave (ByVal SaveAsUI As Boolean, Cancel As Boolean)   -  person Nathan_Sav    schedule 19.11.2015

Ответы (3)


arrow_upward
0
arrow_downward

Вам просто нужно протестировать объект Wb в начале вашего события `` примерно так:

If Wb <> ThisWorkbook Then Exit Sub
'Or
If Wb.Name <> ThisWorkbook.Name Then Exit Sub

Или вы можете поместить код App_WorkbookBeforeSave в модуль Workbook_BeforeSave в ThisWorkBook, чтобы он запускался только этой рабочей книгой! ;)

Вот ваш полный код:

Option Explicit
Private WithEvents App As Excel.Application

Private Sub Workbook_Open()
    Set App = Application
End Sub

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Wb <> ThisWorkbook Then Exit Sub
    'If Wb.Name <> ThisWorkbook.Name Then Exit Sub

    App.EnableEvents = False
    With App.Dialogs(xlDialogSaveAs)
        Call .Show(MakeDocName, xlOpenXMLWorkbookMacroEnabled)
    End With
    App.EnableEvents = True
    Cancel = True
End Sub


Function MakeDocName() As String
    Dim theName As String
    Dim pName As String
    Dim pUName As String

    pName = Sheets("DESCRIPTION").Range("b4")
    pUName = UCase(pName)
    theName = pUName & " RN " & Sheets("DESCRIPTION").Range("b2")
    MakeDocName = theName
End Function
person R3uK    schedule 19.11.2015
comment
Весь этот код уже есть в модуле ThisWorbook. По этой причине я не могу понять, почему это работает и в других. Во всяком случае, теперь я пытаюсь использовать ваше первое предложение. - person Riccardo; 19.11.2015
comment
Итак, просто ваш код находится в пользовательском событии для всех рабочих книг, вы можете взять код из App_WorkbookBeforeSave и вставить его в Workbook_BeforeSave (которое вам может потребоваться создать первым), и у вас не будет этой проблемы! ;) - person R3uK; 19.11.2015
comment
Спасибо R3uK за помощь. Это было действительно полезно. - person Riccardo; 20.11.2015
comment
@Riccardo: Рад, что смог помочь! ;) Когда вы применили предложенное мной решение, не могли бы вы подтвердить мой ответ? И найдите минутку, чтобы пройти экскурсию: stackoverflow.com/tour Наслаждайтесь ТАК! ;) - person R3uK; 20.11.2015

arrow_upward
0
arrow_downward

Вы можете использовать

ActiveWorkbook.SaveAs _
Filename:="C:\Allpath\YourFileName", _
FileFormat:= 'HereYourFileFormat" _
CreateBackup:=False

Посмотрите здесь форматы файлов. Это типы форматов файлов для excel2003:

xlCSV
xlCSVMSDOS
xlCurrentPlatformText
xlDBF3
xlDIF
xlExcel2FarEast
xlExcel4
xlAddIn
xlCSVMac
xlCSVWindows
xlDBF2
xlDBF4
xlExcel2
xlExcel3
xlExcel4Workbook
xlExcel5
xlExcel7
xlExcel9795
xlHtml
xlIntlAddIn
xlIntlMacro
xlSYLK
xlTemplate
xlTextMac
xlTextMSDOS
xlTextPrinter
xlTextWindows
xlUnicodeText
xlWebArchive
xlWJ2WD1
xlWJ3
xlWJ3FJ3
xlWK1
xlWK1ALL
xlWK1FMT
xlWK3
xlWK3FM3
xlWK4
xlWKS
xlWorkbookNormal
xlWorks2FarEast
xlWQ1
xlXMLSpreadsheet
person genespos    schedule 19.11.2015

arrow_upward
0
arrow_downward

Наконец я нашел решение. Я просто удалил событие приложения и использовал следующий код в модуле ThisWorkbook.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = False
    If Application.ThisWorkbook.Path = "" Then
        With Application.Dialogs(xlDialogSaveAs)
            Call .Show(MakeDocName, xlOpenXMLWorkbookMacroEnabled)
        End With
    Else
        Application.ThisWorkbook.Save
    End If
    Cancel = True
End Sub

Function MakeDocName() As String
    Dim theName As String
    Dim pName As String
    Dim pUName As String
    Dim uscore As String
    uscore = "_"

    pName = Sheets("DESCRIPTION").Range("b4")
    pUName = UCase(pName)

    theName = pUName & " RN " & Sheets("DESCRIPTION").Range("b2")

    MakeDocName = theName
End Function
person Riccardo    schedule 20.11.2015