Название файла по шаблону

Дата: Воскресенье, 19.05.2019, 13:08 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 42

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Добрый день!
У меня есть фалик, в котором я написал небольшой макрос и вывел его на кнопку на листе.
Его задача довольно проста: Сохранить файл по определённому шаблону, данные которые берутся из ячеек
Но так как с макросами я дружу довольно плохо, не смог разобраться, как сделать так, чтобы:

1. Дата бралась в определённом формате (он пишет 21.05.2019, а мне нужно только 21.05)
2. Если ячейки пустые, то данные оттуда не берутся (с 23 по 29 строки) Сейчас он учитывает эти ячейки, даже если они пусты
3. После сохранения, эта книга закрылась

Файлик примера во вложении

К сообщению приложен файл: --21.05.2019--_.xlsm (34.9 Kb)

Сообщение отредактировал Narahon - Воскресенье, 19.05.2019, 14:57

Дата: Понедельник, 20.05.2019, 10:49 | Сообщение № 2

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Так нужно?
[vba]

Код

Private Sub CommandButton1_Click()
    Dim strPath As String, strName As String
    raz_ = " + "
    For i = 22 To 29
        If Cells(i, 1) <> "" Then
            x_ = x_ & raz_ & Cells(i, 1)
        End If
    Next i
    If Len(x_) = 0 Then Exit Sub
    If Not IsDate(Cells(1, 4)) Then Exit Sub
    If Cells(34, 10) = "" Then Exit Sub
    x_ = Mid(x_, Len(raz_) + 1)
    strPath = "g:\Моя\Стереть\"  'Путь к файлу
    strName = "Доставка - Вагон - " & Format(Cells(1, 4), "DD.MM") & " - " & Cells(34, 10) & " - " & x_ & ".xlsm" 'Имя файла
    ThisWorkbook.SaveAs Filename:=strPath & strName
    ThisWorkbook.Close
End Sub

[/vba]

К сообщению приложен файл: -21.05.2019-1.xlsm (31.9 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Дата: Понедельник, 20.05.2019, 12:30 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 42

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Огромное спасибо!

Вот только появляется ошибка при нажатии на кнопку, что указанный путь не найден, как я понимаю, это вот эта строчка:

Цитата _Boroda_, 20.05.2019 в 10:49, в сообщении № 2 ()

strPath = "g:\Моя\Стереть\" 'Путь к файлу

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

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

Дата: Понедельник, 20.05.2019, 14:34 | Сообщение № 4

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Конечно, у Вас в макросе это была папка Темп. Я у себя ее засорять не хочу, у меня другая помойка есть, поэтому я и написал свой путь
Поясните, как Вы хотите сохранить файл, не указывая место сохранения?
Можно сохранять в то же место, где находится файл с макросом. Тогда напишите так
[vba]

Код

strPath = ThisWorkbook.Path & "\"

[/vba]
[vba]

Код

Private Sub CommandButton1_Click()
    Dim strPath As String, strName As String
    raz_ = " + "
    For i = 22 To 29
        If Cells(i, 1) <> "" Then
            x_ = x_ & raz_ & Cells(i, 1)
        End If
    Next i
    If Len(x_) = 0 Then Exit Sub
    If Not IsDate(Cells(1, 4)) Then Exit Sub
    If Cells(34, 10) = "" Then Exit Sub
    x_ = Mid(x_, Len(raz_) + 1)
    strPath = ThisWorkbook.Path & "\"  'Путь к файлу
    strName = "Доставка - Вагон - " & Format(Cells(1, 4), "DD.MM") & " - " & Cells(34, 10) & " - " & x_ & ".xlsm" 'Имя файла
    Application.DisplayAlerts = 0
    ThisWorkbook.SaveAs Filename:=strPath & strName
    Application.DisplayAlerts = 1
    ThisWorkbook.Close
End Sub

[/vba]

К сообщению приложен файл: -21.05.2019-2.xlsm (32.0 Kb)

Дата: Понедельник, 20.05.2019, 14:52 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 42

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

_Boroda_,

Цитата _Boroda_, 20.05.2019 в 14:34, в сообщении № 4 ()

Можно сохранять в то же место, где находится файл с макросом. Тогда напишите так

Да, это самый идеальный вариант!
Огромнейшее Вам спасибо за помощь! Очень сильно помогли!

С меня +

Дата: Понедельник, 20.05.2019, 15:03 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 42

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

И ещё вопросик, а можно ли в VBA сделать перед сохранением подмену запрещенных символов < > | ? \ / : " * на - в названии файлика?

Сообщение отредактировал Narahon - Понедельник, 20.05.2019, 15:03

Дата: Понедельник, 20.05.2019, 15:15 | Сообщение № 7

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Да. Например с помощью [vba]

Код

Replace(Где_меняем, Что_меняем, На_что_меняем)

[/vba]

InExSu

Дата: Вторник, 21.05.2019, 23:09 | Сообщение № 8

Группа: Друзья

Ранг: Ветеран

Сообщений: 648

Репутация: 96 ±

Замечаний: 0% ±

Excel 2010, 365

Привет!

Цитата Narahon, 20.05.2019 в 15:03, в сообщении № 6 ()

подмену запрещенных символов

[vba]

Код

Public Function Заменить_Запрещённые(ByVal msg As String, _
        Optional ByVal sNew As String = vbNullString) _
        As String

    Dim a1() As Variant
    a1 = Array("<", ">", "|", "?", "\", "/", ":", Chr(34), "*")

    Dim x As Long

    For x = LBound(a1) To UBound(a1)

        msg = Replace$(msg, a1(x), sNew)

    Next

    Заменить_Запрещённые = msg

End Function

[/vba]

Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac

Дата: Пятница, 24.05.2019, 15:58 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 42

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата _Boroda_, 20.05.2019 в 15:15, в сообщении № 7 ()

Да. Например с помощью

Спасибо!

Но как я понимаю, здесь нельзя сразу перечислить все недопустимые символы?

У меня код пока получился следующим образом:

[vba]

Код

Private Sub CommandButton1_Click()
    Dim strPath As String, strName As String
    raz_ = " + "
    For i = 22 To 29
        If Cells(i, 1) <> "" Then
            x_ = x_ & raz_ & Cells(i, 1)
        End If
    Next i
    If Len(x_) = 0 Then Exit Sub
    If Not IsDate(Cells(1, 4)) Then Exit Sub
    If Cells(34, 10) = "" Then Exit Sub
    x_ = Mid(x_, Len(raz_) + 1)
    strPath = ThisWorkbook.Path & "\"  'Путь к файлу
    strName = "Доставка - Вагон - " & Format(Cells(1, 4), "DD.MM") & " - " & Cells(34, 10) & " - " & x_ & ".xlsm" 'Имя файла
    Application.DisplayAlerts = 0
    ThisWorkbook.SaveAs Filename:=strPath & Replace(strName, "/", "-")
    Application.DisplayAlerts = 1
    ThisWorkbook.Close
End Sub

[/vba]

Дата: Пятница, 24.05.2019, 16:19 | Сообщение № 10

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Почему нельзя? Льзя. InExSu продемонстрировал выше пример
Можно без функции, вот так примерно
[vba]

Код

Private Sub CommandButton1_Click()
    Dim strPath As String, strName As String
    raz_ = " + "
    For i = 22 To 29
        If Cells(i, 1) <> "" Then
            x_ = x_ & raz_ & Cells(i, 1)
        End If
    Next i
    If Len(x_) = 0 Then Exit Sub
    If Not IsDate(Cells(1, 4)) Then Exit Sub
    If Cells(34, 10) = "" Then Exit Sub
    x_ = Mid(x_, Len(raz_) + 1)
    strPath = ThisWorkbook.Path & "\"  'Путь к файлу
    strName = "Доставка - Вагон - " & Format(Cells(1, 4), "DD.MM") & " - " & Cells(34, 10) & " - " & x_ & ".xlsm" 'Имя файла
    ar = Array("<", ">", "|", "?", "\", "/", ":", Chr(34), "*")
    For i = LBound(ar) To UBound(ar)
        strName = Replace(strName, ar(i), "_")
    Next i
    Application.DisplayAlerts = 0
    ThisWorkbook.SaveAs Filename:=strPath & strName
    Application.DisplayAlerts = 1
    ThisWorkbook.Close
End Sub

[/vba]