Страницы: 1
RSS
Макрос, изменяющий "м2" на более "красивый" вариант
 
Доброго времени суток, уважаемые!  
Воспаленное сознание родило следующий макрос, приводящий написание "м2" в более "красивый" вид (цифры приподняты). Макрос действует в выделенном диапазоне. Ищет в выделении значения "м2" "м3" (значения для поиска можно добавлять) и для цифр в этих строках изменяет шрифт на superscript.  
Вопросы в следующем:  
1. Может, кому пригодится?  
2. Гуру-мастера - может посмотрите код - вдруг я велосипед изобрел?  
Файл-пример прилагаю (код процедуры в единственном модуле проекта).  
Текст процедуры:  
Sub Надстрочный_символ_м2_м3()  
'хочется, чтобы в текстовой строке, содержащейся в ячейке, все "м2" и "м3" заменялись на более "красивый вариант"  
'с "приподнятым" шрифтом для цифр  
Dim MyRange As Range 'переменная для объекта Selection  
Dim MyCell As Range 'переменная для объекта Cell, которые будем перебирать в выделенном диапазоне  
Dim intI As Integer 'переменная для определения номера позиции вхождений "м2" или "м3" в проверяемой строке  
Dim strChecking As String 'переменная для хранения строки, которую будем курочить  
Dim arrInNumber() As Integer    'массив неизвестной пока размерности для хранения значений позиций вхождения искомой строки  
                               'в проверяемой  
Dim arrInStr(2) As String 'массив, в который заносим строки, которые надо искать/заменять/изменять  
Dim intJ As Integer 'переменная для определения размерности массива  
Dim intK As Integer 'переменная для определения размерности массива arrInStr  
 
'присваиваем элементам массива значения для поиска  
arrInStr(1) = "м2"  
arrInStr(2) = "м3"  
Set MyRange = Selection 'устанавливаем переменной объект (выделенный диапазон)  
 
'ПОГНАЛИ! Для каждой ячейки в выделенном фрагменте:  
For Each MyCell In MyRange  
   MyCell.Activate 'как выяснилось, без активации ячейки никак - все действия по изменению шрифта происходят в активной  
                   'ячейке  
   strChecking = CStr(MyCell.Value)  
   For intK = LBound(arrInStr()) To UBound(arrInStr())  
       intI = 1  
       intJ = 1  
'проверяем, есть ли в строке элемент arrInStr() вообще,  т.е. то, что надо поменять  
       If InStr(intI, strChecking, arrInStr(intK)) > 0 Then  
'пока вхождение элемента массива arrInStr(), определенное для разных стартовых позиций поиска будет давать значение >0  
'запускаем цикл, который находит номер позиции вхождения и присваивает его соответсвующему элементу массива arrInNumber()  
           Do  
   'изменяем размерность массива при увеличении количествва найденных вхождений  
               ReDim Preserve arrInNumber(intJ)  
   'присваиваем соотвествующему элементу массива номер найденного вхождения  
               arrInNumber(intJ) = InStr(intI, strChecking, arrInStr(intK))  
   'изменяем начальную позицию для поиска в строке вхождения  
               intI = InStr(intI, strChecking, arrInStr(intK)) + 1  
   'увеличиваем размерность массива arrInNumber()  
               intJ = intJ + 1  
   'условие проверяем в конце цикла, т.к. начальной проверкой через if мы уже убедились, что такое вхождение есть  
   'хотя бы в одном экземпляре  
           Loop While InStr(intI, strChecking, arrInStr(intK)) > 0  
     
   'для каждого найденного вхождения в строке (т.е. для всех элементов массива)  
           For intI = LBound(arrInNumber()) To UBound(arrInNumber())  
   'изменяем шрифт для цифр в "м2"  
               ActiveCell.Characters(Start:=arrInNumber(intI) + 1, Length:=1).Font.Superscript = True  
           Next intI  
     
       End If  
   Next intK  
 
Next MyCell
Кому решение нужно - тот пример и рисует.
 
The_Prist, спасибо!  
Вот ведь - что называется сам пишу, сам не понимаю... :О)
Кому решение нужно - тот пример и рисует.
 
Ээээ... а как же справка, которая говорит, что фунция Array () - про нее ж речь идет, правда? - возвращает значение типа Variant?  
 
"...Returns a Variant containing an array..."
Кому решение нужно - тот пример и рисует.
 
В смысле - установить массив как тип variant, задать его через функцию Array и потом преобразовывать в тип string, правильно?
Кому решение нужно - тот пример и рисует.
 
Убейте мои 2 прошлых поста - я понял, спасибо! :О)
Кому решение нужно - тот пример и рисует.
 
{quote}{login=Пытливый}{date=01.09.2010 02:17}{thema=}{post}Убейте мои 2 прошлых поста {/post}{/quote}  
Услуга платная.
 
"Я мзды не беру...За державу обидно..."? :)
Страницы: 1
Наверх