Макрос для выделения кириллицы в Word

[inspirer161]

В общем интересная штука получается. Последняя редакция макроса, уже встроенного в документ запускается и работает, но есть одно НО. На системе, где японский язык стоит основным не работает. Окно, которое выскакивает со скопированными словами русскими (там порушенная кодировка), а вот на системе, где русский язык стоит основным там всё работает.
Вот этот код

Sub GetRus()
Dim s$, v
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[А-ЯЁ.,; ()-]+"
.ignorecase = True
For Each v In .Execute(Selection.Range)
v = Trim(v)
If Right$(v, 1) = ";" Then v = Left(v, Len(v) - 1)
If Len(v) Then If v <> "-" Then s = s & Trim$(v) & vbCrLf
Next
End With
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'DataObject
.SetText s
.PutInClipboard
End With
MsgBox "Текст помещен в буфер обмена", vbInformation
End Sub

сам запускает новое окно и туда полностью все кириллические слова из текста копирует. Вот он работал на системе, где японский язык стоит основным. Можно ли в этом макросе отключить создание нового окна и чтобы кириллические слова искал только в выделяемом фрагменте?

Просто наверное проще этот поправит, чем решить проблему с кракозябрами, которые вылезают в системе, где японский язык основной (других версий нет почему так)

[Казанский]

В этом варианте:
- избавился от русских букв в коде;
- текст в буфер помещается через новый документ;
- нет сообщений.
Это мой окончательный вариант, больше менять не буду.

Sub GetRus()
Dim s$, v
With CreateObject("vbscript.regexp")
  .Global = True
  .Pattern = "[" & ChrW$(1040) & "-" & ChrW$(1071) & ChrW$(1025) & ".,; ()-]+"
  .ignorecase = True
  For Each v In .Execute(Selection.Range)
    v = Trim(v)
    If Right$(v, 1) = ";" Then v = Left(v, Len(v) - 1)
    If Len(v) Then If v <> "-" Then s = s & Trim$(v) & vbCrLf
  Next
End With
Application.ScreenUpdating = False
With Documents.Add
  .Range.InsertAfter s
  .Range.Copy
  .Close wdDoNotSaveChanges
End With
Application.ScreenUpdating = True
End Sub

[inspirer161]

Сообщение от Казанский

В этом варианте:
- избавился от русских букв в коде;
- текст в буфер помещается через новый документ;
- нет сообщений.
Это мой окончательный вариант, больше менять не буду.

Sub GetRus()
Dim s$, v
With CreateObject("vbscript.regexp")
  .Global = True
  .Pattern = "[" & ChrW$(1040) & "-" & ChrW$(1071) & ChrW$(1025) & ".,; ()-]+"
  .ignorecase = True
  For Each v In .Execute(Selection.Range)
    v = Trim(v)
    If Right$(v, 1) = ";" Then v = Left(v, Len(v) - 1)
    If Len(v) Then If v <> "-" Then s = s & Trim$(v) & vbCrLf
  Next
End With
Application.ScreenUpdating = False
With Documents.Add
  .Range.InsertAfter s
  .Range.Copy
  .Close wdDoNotSaveChanges
End With
Application.ScreenUpdating = True
End Sub

Этот вариант работает, благодарю, не зря кушаете свой хлеб =)