|
Function Replace_symbols(ByVal txt As String) As String
St$ = "~!@/\#$%^&*=|`"""
For i% = 1 To Len(St$)
S$ = Mid(St$, i, 1)
' If S$ = "?" Then Stop
txt = Replace(txt, S$, "_")
Next
Replace_symbols = Replace(Replace_symbols, ChrW(&H2665), "_") 'замена знака вопроса
Replace_symbols = txt
'заменить ижние подчеркивания
Do While Replace_symbols Like "*" & "__" & "*"
Replace_symbols = Replace(Replace_symbols, "__", "_", 1, -1, vbTextCompare)
Loop
'https://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=47811
'для поиска * или ? перед символом ставиться ~
'~* или ~?
End Function
Замена запрещённых символов в имени файла или папки
|
При попытке сохранить файл под именем, заданным пользователем, вы можете получить ошибку - если в имени файла (папки) присутствуют запрещённые символы.
Этого легко избежать, если в процессе формирования имени файла удалить из него недопустимые символы, заменив их символом подчёркивания:
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
|
