13 Апр 2018

Сохранение книги Excel с названием файла из ячейки через VBA

Имеется определенный шаблон куда записываются данные и нужно часто сохранять эту заполненную таблицу Excel в папку, например с накладными. Чтобы избежать рутину по написанию имен файла вручную, можно сделать так, чтобы файл сохранялся с именем из заполненных ячеек.

Изначальный шаблон с ячейками, после сохранения, должен оставаться неизменным, т.е. в папку сохраняется его копия с измененными данными в ячейках. То же самое, если нажали бы "Файл" - "Сохранить как..."

01Имеем шалон, в котором я выделил красным те ячейки, которые заполнил и хочу чтобы из них формировалось новое имя для сохранения файла excel.

02После того как нажали кнопку "Сохранить накладную", заходим в папку с сохраненным файлом и смотрим его имя. Сейчас оно у меня выглядит "01 Монтаж, -Рога-Копыта-, ул. Пушкина, дом Калатушкина-17-28 - -02-"

В имени файла не могут присутствовать запрещенные символы, такие как ""/ и т.д. Поэтому применили функцию автозамены запрещенных символов в имени файла на "-"

Код VBA Excel модуль с комментариями:

Function Replace_symbols(ByVal txt As String) As String 'Убираем запрещённые в именах файлов символы!
    Dim st$, i&
    'Ковычки и слэши в данном случае!
    st$ = "/"""
    For i& = 1 To Len(st$)
    'Заменяем их на тире "-"
        txt = Replace(txt, Mid(st$, i, 1), "-")
    Next
    Replace_symbols = txt
End Function
Sub SaveMe()
    'Где будет сохраняться
    ПутьКПапке = "S:\Рабочий стол\СКЛАД\Расходные накладные по складу\2017\Январь\"
    'С какого листа берется имя для файла
    With Worksheets("Лист1")
    'Имя_для_сохранения начинается со слова в ячейке [I8]
        Имя_для_сохранения = .[I8]
    End With
    'Следующие слова в имени сохранения файла после [I8], берутся из следющих ячеек, с заменой запрещенных символов из функции Replace_symbols
    ActiveWorkbook.SaveAs ПутьКПапке & Replace_symbols([G2]) & " " & Имя_для_сохранения & ", " & Replace_symbols([D10]) & ", " & Replace_symbols([H10]) & " - " & Replace_symbols([M8]) & ".xlsm"
MsgBox "Накладная сохранена в папке расходных накладных!"
End Sub

*Названия листов, пути для сохранения, имена ячеек меняем на свои.

Оцените материал