Как преобразовать русские буквы в латиницу?

[Alexander_Gr]

Привет всем! Подскажите макро который помогает переводить русские буквы в латиницу

Например ячейка
А1 Москва
А2 Самара
и т.д.

Перевод:
В1 Moskva
B2 Samara

Спасибо!
Spasibo!

[pashulka]

Private Sub MyTranslit()

iRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
iEnglish = Array("", "a", "b", "v", "g", "d", _
"e", "jo", "zh", "z", "i", "jj", "k", "l", "m", _
"n", "o", "p", "r", "s", "t", "u", "f", "h", "c", _
"ch", "sh", "zch", "''", "'y", "'", "eh", "ju", "ja")

With ThisWorkbook.Worksheets(1)
     'Укажите свою рабочую книгу, рабочий лист
     If Not .ProtectContents Then
        With .Range(.[A1], .[A65536].End(xlUp)).Offset(, 1)
             .Value = .Offset(, -1).Value
             'При работе с диапазоном имеет смысл ознакомиться и
             'воспользоваться следующими свойствами
             'об'екта Application :
             'ScreenUpdating, Calculation
             'а при необходимости, ещё и нижеперечисленными :
             'EnableEvents, DisplayAlerts, EnableCancelKey
             For iCount% = 1 To Len(iRussian$) '33
                 iSmbRus$ = Mid(iRussian, iCount%, 1)
                 iSmbEng$ = iEnglish(iCount%)
                 .Replace What:=iSmbRus$, Replacement:=iSmbEng$, MatchCase:=True
                 .Replace What:=StrConv(iSmbRus$, vbProperCase), _
                 Replacement:=StrConv(iSmbEng$, vbProperCase), MatchCase:=True
             Next
             'Для аналогичных действий со строкой можно использовать
             'стандартную функцию рабочего листа ПОДСТАВИТЬ()
             'Application.Substitute(), WorksheetFunction.Substitute() 'и т.п.
             '(которая чувствительна к регистру)
             'или функцию Replace(), которая появилась в MS Office2000(VB6)
             '(эта функция имеет аргумент Compare, позволяющий осуществлять
             'замену без учёта регистра)
        End With
     Else
        MsgBox "Рабочий лист защищён", vbCritical, ""
        'Для того, чтобы изменить значение защищённой ячейки можно :
        '- использовать необязательный именованный аргумент
        'UserInterfaceOnly:=True метода Protect, причём,
        'для версий MS Excel 97, 2000 указание существ. пароля необязательно
        '- или снять, а затем, после всех изменений,
        'программно установить нужный пароль
        'В MS Excel XP можно использовать метод Replace в защищённом листе,
        'но замена будет осуществляться только в незащищённых ячейках
     End If
End With

End Sub

P.S. Символы транслита могут быть изменены в соответствии с личными требованиями.

[WIC]

я кажется поднимал тему такую.
решил ее с помощью программы Пунто.
Если она у вас установлена, можно воспользоваться.

[pashulka]

Не могу не заметить, что программа Punto не имеет отношения к Microsoft Excel, а ведь именно в этом разделе опубликован поставленный вопрос. А вот мой макрос, который также справляется с этой задачей, имеет самое прямое отношение, впрочем, тот же принцип можно использовать и в Microsoft Word, но это уже совсем другая история.

[Alexander_Gr]

Спасибо!

[Alexander_Gr]

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

Например:

Была ячейка

A1: Привет всем

Стала:

A1: Privet vsem

[pashulka]

With ThisWorkbook.Worksheets(1)   
        ...
        With .Range("A:A") 'укажите нужный столбец
               For iCount% = 1 To Len(iRussian$) '33
               ...

[Alexander_Gr]

pashulka, а можно сделать что бы не только A ячечи заменялись, а все которые в листе рабочем?

[pashulka]

Производить замену во всех (Cells) ячейках рабочего листа, не имеет особого смысла, т.к. вполне достаточно заменить .Range(...) на .UsedRange