Друзья, возникла проблема: другой макрос не видит файлы, в названии которых есть кириллица. При этом я нашел функцию, которая способна транслитерировать кириллицу в латиницу, но моих знаний не хватает на то, чтобы создать из этого полноценный макрос для повального переименования файлов в духе: есть определенная папка (скажем, C:\Users\User\Desktop, в ней файлы, например, 01_02_Иванов.xlxs, и надо её переименовать в 01_02_Ivanov.xlxs
Сама функция:
[vba]
Код
Function TranslitText(RusText As String) As String Dim RusAlphabet As Variant 'массив из букв русского алфавита RusAlphabet = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
Dim EngText As String, Letter As String, Flag As Boolean
For i = 1 To Len(RusText) 'цикл по всем символам русского текста Letter = Mid(RusText, i, 1) Flag = 0 For j = 0 To 32 'цикл по всем буквам русского алфавита If RusAlphabet(j) = LCase(Letter) Then 'если символ из текста совпал с буквой из русского алфавита... Flag = 1 If RusAlphabet(j) = Letter Then 'проверка на регистр (верхний или нижний) EngText = EngText & EngAlphabet(j) '... то добавляем соответствующую букву из английского алфавита Exit For Else EngText = EngText & UCase(EngAlphabet(j)) Exit For End If End If Next j If Flag = 0 Then EngText = EngText & Letter 'если символа из текста в алфавите нет (например, знаки препинания и т.п.), то добавляем символ без изменения Next i TranslitText = EngText End Function
[/vba]
Если кто поможет, буду сильно благодарен.
Здравствуйте!
Друзья, возникла проблема: другой макрос не видит файлы, в названии которых есть кириллица. При этом я нашел функцию, которая способна транслитерировать кириллицу в латиницу, но моих знаний не хватает на то, чтобы создать из этого полноценный макрос для повального переименования файлов в духе: есть определенная папка (скажем, C:\Users\User\Desktop, в ней файлы, например, 01_02_Иванов.xlxs, и надо её переименовать в 01_02_Ivanov.xlxs
Сама функция:
[vba]
Код
Function TranslitText(RusText As String) As String Dim RusAlphabet As Variant 'массив из букв русского алфавита RusAlphabet = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
Dim EngText As String, Letter As String, Flag As Boolean
For i = 1 To Len(RusText) 'цикл по всем символам русского текста Letter = Mid(RusText, i, 1) Flag = 0 For j = 0 To 32 'цикл по всем буквам русского алфавита If RusAlphabet(j) = LCase(Letter) Then 'если символ из текста совпал с буквой из русского алфавита... Flag = 1 If RusAlphabet(j) = Letter Then 'проверка на регистр (верхний или нижний) EngText = EngText & EngAlphabet(j) '... то добавляем соответствующую букву из английского алфавита Exit For Else EngText = EngText & UCase(EngAlphabet(j)) Exit For End If End If Next j If Flag = 0 Then EngText = EngText & Letter 'если символа из текста в алфавите нет (например, знаки препинания и т.п.), то добавляем символ без изменения Next i TranslitText = EngText End Function
. Апартеид какой-то, честное слово! Что-то там не то. А переименование - не думаю, что это хорошее решение Но если очень хочется - в этой теме http://www.programmersforum.ru/showthread.php?t=60191 пост №6, макрос №2 Строку [vba]
. Апартеид какой-то, честное слово! Что-то там не то. А переименование - не думаю, что это хорошее решение Но если очень хочется - в этой теме http://www.programmersforum.ru/showthread.php?t=60191 пост №6, макрос №2 Строку [vba]