1

Тема: Как перевести цифры в химических формулах в нижний индекс

Помогите, пожалуйста, с макросом для изменеия регистра цифр на subscript в неотформатированной химической формуле (к примеру, в С2Н5OH  smile )
Чего бы хотелось:
1. Изменение регистра всех цифр ТОЛЬКО в выделенном фрагменте
2. Перевод в нижний регистр также запятых и точек между цифрами

Отредактировано sylvio (19.03.2010 16:23:12)

2

Re: Как перевести цифры в химических формулах в нижний индекс

Вот такая процедура переводит все цифры в нижний индекс в выделенном фрагменте. Данный вариант предполагает, что индексы состоят только из одной цифры.
Для дальнейшего усовершенствования неплохо бы привести формулу посложнее.

Sub Subscripts()
  Dim rngChar As Range
  Dim i As Long, CharCount As Long
  
  CharCount = Selection.Characters.Count
  If CharCount = 0 Then Exit Sub
  For i = 1 To CharCount
    Set rngChar = Selection.Characters(i)
    If IsNumeric(rngChar.Text) Then rngChar.Font.Subscript = True
  Next
End Sub

3

Re: Как перевести цифры в химических формулах в нижний индекс

лучше воспользоваться поиском и заменой:

Sub ToSubscript()
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([0-9]@)"
    .MatchWildcards = True
    .Replacement.Font.Subscript = True
    .Replacement.Text = "\1"
    .Wrap = wdFindStop
    .Execute Replace:=wdReplaceAll
  End With
End Sub
Лучше день потерять — потом за пять минут долететь!

4

Re: Как перевести цифры в химических формулах в нижний индекс

adev и viter.alex большое спасибо за быстрый ответ.
Со знаками разобрался добавив еще один цикл поиска и замены на точки и запятые.
Тут пришла идея, что было бы удобнее, если бы макрос исполнялся для той формулы, на которой стоит курсор, то есть без выделения.
Как так сделать?

PS Для примера формула Fe0.33Ni0.5AlCo2

Отредактировано sylvio (19.03.2010 23:24:00)

5

Re: Как перевести цифры в химических формулах в нижний индекс

Можно сделать

Sub ToSubscript()
  Dim Sel As Long
  Sel = Selection.Start 'Запоминаем положение курсора
  Selection.MoveEndUntil " " 'раздвигаем выделение до пробела справа
  Selection.MoveStartUntil " ", wdBackward 'раздвигаем выделение до пробела слева
  'Поиск и замена в выделении
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([0-9]@)"
    .MatchWildcards = True
    .Replacement.Font.Subscript = True
    .Replacement.Text = "\1"
    .Wrap = wdFindStop
    .Execute Replace:=wdReplaceAll
    .Text = "[.,]"
    .Replacement.Text = ","
    .Wrap = wdFindStop
    .Execute Replace:=wdReplaceAll
  End With
  'Возвращаем курсор на место
  ActiveDocument.Range(Sel, Sel).Select
End Sub
Лучше день потерять — потом за пять минут долететь!

6

Re: Как перевести цифры в химических формулах в нижний индекс

Спасибо большое! Это именно то, что я хотел.
Немного вот изменил, чтобы и точки с запятыми переходили в subscript.


Sub ToSubscript()
  Dim Sel As Long
  Sel = Selection.Start 'Запоминаем положение курсора
  Selection.MoveEndUntil " " 'раздвигаем выделение до пробела справа
  Selection.MoveStartUntil " ", wdBackward 'раздвигаем выделение до пробела слева
  'Поиск и замена в выделении
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([0-9]@)"
    .MatchWildcards = True
    .Replacement.Font.Subscript = True
    .Replacement.Text = "\1"
    .Wrap = wdFindStop
    .Execute Replace:=wdReplaceAll
    .Text = "([.,])"
    .Replacement.Text = "\1"
    .Wrap = wdFindStop
    .Execute Replace:=wdReplaceAll
  End With
  'Возвращаем курсор на место
  ActiveDocument.Range(Sel, Sel).Select
End Sub

]

7

Re: Как перевести цифры в химических формулах в нижний индекс

Тогда, хотя бы для симметрии, надо иметь макрос и для superscript'а. Что надо изменить?

8

Re: Как перевести цифры в химических формулах в нижний индекс

sylvio пишет:

Немного вот изменил, чтобы и точки с запятыми переходили в subscript.

можно проще:
.Text = "([0-9.,]@)"

9

Re: Как перевести цифры в химических формулах в нижний индекс

benoni пишет:

Тогда, хотя бы для симметрии, надо иметь макрос и для superscript'а. Что надо изменить?

.Replacement.Font.Superscript = True

10

Re: Как перевести цифры в химических формулах в нижний индекс

Спасибо, Денис!

11

Re: Как перевести цифры в химических формулах в нижний индекс

У меня та же проблема, но я работаю в Excel 2003 и данный макрос не хочет выполнятся на этой версии. Нельзя ли переписать его для данного приложения?