Здесь многоточием помечены повторяющиеся конструкции кода:
Public Sub CommandClick() Dim rus As String Dim eng As String Dim lat As String Dim pth As String pth = "c:\" Open pth + "Mytext.dat" For Input As #1 Input #1, rus Input #1, eng Input #1, lat Close #1 Application.Keyboard (1049) Selection.TypeText Text:=Conv(Convert(rus), 1049) Selection.TypeParagraph Application.Keyboard (2057) Selection.TypeText Text:=Conv(Convert(eng), 1033) Selection.TypeParagraph Application.Keyboard (1062) Selection.TypeText Text:=Conv(Convert(lat), 1062) Application.Keyboard (2057) End Sub Function Convert(str As String) As String special = True leng = Len(str) For i = 1 To leng If i > leng Then Exit For kod = Asc(Mid(str, i, 1)) ' special letters If special Then If i <= leng - 2 Then kod2 = Asc(Mid(str, i + 1, 1)) kod3 = Asc(Mid(str, i + 2, 1)) If (kod = 95) And (kod2 = 95) And (kod3 = 79) Then str = Left(str, i - 1) + Chr(187) + Right(str, leng - i - 2) leng = leng - 2 ElseIf ' ... AK: далее еще 5 таких же конструкций для разных Kod3 End If End If If i <= leng - 1 Then If (kod = 58) And (kod2 = 65) Then str = Left(str, i - 1) + (176) + Right(str, leng - i - 1) leng = leng - 1 ElseIf '... AK: далее еще 20 таких же конструкций для разных Kod2 End If End If End If ' russian letters If kod > 127 And kod < 176 Then newStr = newStr + Chr(kod + 64) ElseIf kod > 223 And kod < 240 Then newStr = newStr + Chr(kod + 16) Else Select Case kod ' latvian letters Case Is = 240 ' E newStr = newStr + Chr(199) ' ... AK: еще 20 таких конструкция для других латышских букв Case Else newStr = newStr + Mid(str, i, 1) End Select End If Next i Convert = newStr End Function Function Conv(str As String, reg_to As Integer) As String For i = 1 To Len(str) k1 = Asc(Mid(str, i, 1)) tmp = StrConv(ChrW(k1), vbFromUnicode) Mid(str, i, 1) = StrConv(tmp, vbUnicode, reg_to) Next i Conv = str ' End Function