Deutsch
Germany.ruФорумы → Архив Досок→ Компьютер & Co

Не по-русски

11.02.04 06:14
Re: Не по-русски
 
barma_lej знакомое лицо
barma_lej
в ответ LEDI S 10.02.04 18:58
А в принципе ты можешь сама всё сделать, зато какое удовлетворение будет Вставь текст огранниченный точками в макрос и всё. Единственная проблема, что и английский текст проконверируется, но его то уж намного меньше , а DM можно заменить с помощью функции Ersetzen
..........
Sub Translit()
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
Dim cSld, iSld, i, j, l As Integer
en$ = "qwertyuiop[]asdfghjkl;'zxcvbnm,.QWERTYUIOP{}ASDFGHJKL:ZXCVBNM<>"
ru$ = "йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЯЧСМИТЬБЮ"
cSld = Application.ActivePresentation.Slides.Count
For iSld = 1 To cSld
Set oSld = Application.ActivePresentation.Slides(iSld)
For Each oShp In oSld.Shapes
If oShp.TextFrame.HasText Then
Set oTxtRng = oShp.TextFrame.TextRange
i = oShp.TextFrame.TextRange.Length
For j = 1 To i
l = InStr(en$, oTxtRng.Characters(j))
If l > 0 Then
enLetter = Mid$(en$, l, 1)
ruLetter = Mid$(ru$, l, 1)
Set oTmpRng = oTxtRng.Replace(FindWhat:=enLetter, _
Replacewhat:=ruLetter, MatchCase:=True)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=enLetter, _
Replacewhat:=ruLetter, MatchCase:=True)
Loop
End If
Next j
End If
Next oShp
Next iSld
End Sub
..........
Папуас папуасу друг, товарищ и корм.
 

Перейти на