Замена запрещённых символов в имени файла или папки

При попытке сохранить файл под именем, заданным пользователем, вы можете получить ошибку - если в имени файла (папки) присутствуют запрещённые символы.

Этого легко избежать, если в процессе формирования имени файла удалить из него недопустимые символы, заменив их символом подчёркивания:

Function Replace_symbols(ByVal txt As String) As String
    St$ = "~!@/\#$%^&*=|`"""
    For i% = 1 To Len(St$)
        txt = Replace(txt, Mid(St$, i, 1), "_")
    Next
    Replace_symbols = txt
End Function

Пример использования:

' формируем путь к новому файлу
Путь = ThisWorkbook.Path & "\" & Replace_symbols(sh.Name) & _
"\" & Replace_symbols(cell) & "\" & Replace_symbols(cell.Next) & ".jpg"

Ещё одна функция - полезная для вывода в прогресс-бар длинного текста (имени файла):

Function ShortText(ByVal LongText$, ByVal Lenght As Long) As String
    ' функция урезает длинную текстовую строку LongText$,
    ' оставляя в ней не более Lenght символов
    On Error Resume Next: LongText$ = Application.Trim(LongText$)
    If Len(LongText$) <= Lenght Then ShortText = LongText$: Exit Function
    arr = Split(LongText$)
    While UBound(arr) > 0
        LongText$ = Split(LongText$, , 2)(1)
        If Len(LongText$) <= Lenght - 3 Then ShortText = "..." & LongText$: Exit Function
        arr = Split(LongText$)
    Wend
    ' не удалось корректно обрезать текст (по пробелу
    ShortText = "..." & Right(LongText$, Lenght)
End Function

Sub ПримерИспользования_ShortText()
    ПолныйАдрес$ = "Москва, ЦАО, Внутригородское муниципальное образование Басманное, ул. Большая Почтовая , д.1"
    УрезанныйАдрес$ = ShortText(ПолныйАдрес$, 50)    ' обрезаем до 60 символов
    MsgBox УрезанныйАдрес$ ' выводит текст "...Басманное, ул. Большая Почтовая , д.1"
End Sub

35403 просмотра

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Алексей, 12 Июл 2016 - 11:41.#1

Я эту формулу использую для формирования id, отлично подходит, но ВНИМАНИЕ ВОПРОС! Что дописать, чтобы оставляло только одно подчеркивание. Сразу скажу, что макрос меня не интересует. Нашел штуку убирает все мульти символы в один, но это мне не подходит, мне нужно чтобы убирало только мульти подчеркивания "____" в "_". Заранее благодарен.

вася, 14 Дек 2014 - 22:20.#2

St$ = "\/:*?""<>|~!@#$%^&=`"

Nata, 18 Фев 2014 - 14:15.#3

Огромное спасибо за функцию, очень помогла. Наташа.

Игорь (администратор сайта), 29 Янв 2013 - 23:55.#4

Макросы в Excel не имеют ничего общего со скриптами в браузерах.
(совсем другой язык, код будет совершенно другой)

Обратитесь на форумы, где пишут браузерные скрипты, - вам подскажут.

Гость, 29 Янв 2013 - 23:48.#5

а как это оформить как скрипт в firefox - хроме ?

TAe1980, 18 Янв 2012 - 00:27.#6

Решил немного доработать функцию Replace_symbols. В ней замена всегда происходит на "_", мне же потребовалось производить иную замену.
Не бог весть что - но возможно кому-ни будь поможет.
Вот код:

Function Replace_path(path)
    StFind = "~!@/\#$%^&*=|`"""
    StRepl = "___--________''"
    For i% = 1 To Len(StFind)
        path = Replace(path, Mid(StFind, i, 1), Mid(StRepl, i, 1))
    Next
    Replace_path = path
End Function

Замена запрещённых символов в имени файла или папки

Комментарии

Настройки просмотра комментариев

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL