Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Помогите, пожалуйста, с макросом для изменеия регистра цифр на subscript в неотформатированной химической формуле (к примеру, в С2Н5OH 
)
Чего бы хотелось:
1. Изменение регистра всех цифр ТОЛЬКО в выделенном фрагменте
2. Перевод в нижний регистр также запятых и точек между цифрами
Отредактировано sylvio (19.03.2010 16:23:12)
Вот такая процедура переводит все цифры в нижний индекс в выделенном фрагменте. Данный вариант предполагает, что индексы состоят только из одной цифры.
Для дальнейшего усовершенствования неплохо бы привести формулу посложнее.
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
лучше воспользоваться поиском и заменой:
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 Subadev и viter.alex большое спасибо за быстрый ответ.
Со знаками разобрался добавив еще один цикл поиска и замены на точки и запятые.
Тут пришла идея, что было бы удобнее, если бы макрос исполнялся для той формулы, на которой стоит курсор, то есть без выделения.
Как так сделать?
PS Для примера формула Fe0.33Ni0.5AlCo2
Отредактировано sylvio (19.03.2010 23:24:00)
Можно сделать
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Спасибо большое! Это именно то, что я хотел.
Немного вот изменил, чтобы и точки с запятыми переходили в 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]
Тогда, хотя бы для симметрии, надо иметь макрос и для superscript'а. Что надо изменить?
Немного вот изменил, чтобы и точки с запятыми переходили в subscript.
можно проще:
.Text = "([0-9.,]@)"
Тогда, хотя бы для симметрии, надо иметь макрос и для superscript'а. Что надо изменить?
.Replacement.Font.Superscript = True
Спасибо, Денис!
У меня та же проблема, но я работаю в Excel 2003 и данный макрос не хочет выполнятся на этой версии. Нельзя ли переписать его для данного приложения?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Как перевести цифры в химических формулах в нижний индекс
Для всех, кто желает совершенствоваться, расти и не любит терять времени понапрасну, предлагаем замечательную шпаргалку по Ворду – форум Ворд Эксперт. На портале о Microsoft Office Word вы узнаете про: активатор для офис2007. Что приятно, это русский форум, очень теплый, там вы не найдете заумных слов и жутких сленговых терминов, в которых без Билла Гейтса не разберешься. Наш сайт о Microsoft Office Word даст ответ про: шаблон dot техусловия. Все просто и понятно.
Заходя в дом - на форум, вы тут же оказываетесь в «прихожей» - разделе, где даются ответы на основные вопросы, как по самому Ворду, так и по устройству форума и сайта. Наш сайт о Microsoft Office Word даст ответ про: отключить нумерацию страниц word. Там же вам предложат почитать что-нибудь интересное (про Ворд, конечно, за этим вы и пришли).
А в «гостиной» вы сможете обсудить программу, вашу версию, ее настройки, особенности работы, форматирование и многое другое. Наш сайт о Microsoft Office Word даст ответ про: математические операции в word. Вас научат оптимизировать эксплуатацию Microsoft Word с помощью макросов. Это совсем не сложно.
В «столовой» форума подаются готовые блюда – оригинальные решения той либо иной проблемы, макросы и многое другое. На портале о Microsoft Office Word вы узнаете про: запуск макросов в word. Если хотите заказать «экзотическое блюдо», добро пожаловать «на кухню» - раздел «заявки на разработку». На портале о Microsoft Office Word вы узнаете про: где изменить интервал в ворде. Оставьте в нем описание своей проблемы, и вам помогут.
Что такое «курилка» объяснять, наверно, никому не надо. Наш сайт о Microsoft Office Word даст ответ про: шаблон рекламного объявления ворд. Заходите и сами все увидите. А пожелания можно оставлять в соответствующем разделе.