mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

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

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

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

Комментарии

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

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

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

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

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

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

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

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

Решил немного доработать функцию 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

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

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _____   _         ____    ____          
| ___| (_) ___ | ___| | _ \ __ _
| |_ | | / __| |___ \ | |_) | / _` |
| _| | | \__ \ ___) | | __/ | (_| |
|_| |_| |___/ |____/ |_| \__, |
|_|
Введите код, изображенный в стиле ASCII-арт.

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

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.