Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос - изменить параметры шрифта в ячейках (одна ячейка - две строчки)
 
#1
07.09.2017 10:24:35
Есть много ячеек, в каждой ячейке текст (две строчки), например

Текст 1
Текст 2

параметры шрифта для обоих текстов (Calibri, размер 11)

нужно написать макрос который будет менять параметры шрифта в выбранных ячейках
нужно Текст 1 уменьшить размер с 11 уменьшить до 9
а Текст 2 увеличить размер с 11 до 13 и сделать текст полужирным.
Текст 1
Текст 2

Хотелось бы чтобы макрос работал для всех выделенных ячеек...
Спасибо...[ :)  
Изменено: Oleksandr - 07.09.2017 10:46:53
 
 
 
#2
07.09.2017 10:29:06
файл покажите. или какой разделитель между текст1 и текст2. символ10 или просто через формат ячейки "перенос по словам"?
 
 
 
#3
07.09.2017 10:43:45
разделитель между текстами СИМВОЛ (10)...
в шапку добавить пример файла...
 
 
 
#4
07.09.2017 10:48:33
а теперь согласно файла в каком столбце это все должно происходить.
 
 
 
#5
07.09.2017 10:58:23
исходные данные в столбце E... можно редактировать прямо там (но там внутри формула)...
или скопировать в соседний столбец F (отредактированный текст из E)...
как проще так и сделайте...

Спасибо :)  
Изменено: Oleksandr - 07.09.2017 17:27:44
 
 
 
#6
07.09.2017 10:59:11
Код
Sub Alemox()
Dim a As Integer
Dim Ячейка As Range
For Each Ячейка In Selection.Cells
    For a = 1 To Len(Ячейка.Text) Step 1
        If Mid(Ячейка.Text, a, 1) = Chr(10) Then
            Ячейка.Characters(Start:=1, Length:=a).Font.Size = 10
            With Ячейка.Characters(Start:=a + 1, Length:=Len(Ячейка.Text) - a).Font
                .Size = 14
                .Bold = True
            End With
            Exit For
        End If
    Next a
Next Ячейка
End Sub
Но данное изменение не применимо для формул
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#7
07.09.2017 11:03:30
файл с примером
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#8
07.09.2017 11:08:25
Цитата
Alemox написал:
Но данное изменение не применимо для формул
тогда я скопирую (как значения)  данные из ячеек с формулами в соседний столбец и к нему применю Ваш макрос...

Спасибо!!!  :)
Макрос работает так как и хотелось.... :D  
 
 
 
#9
07.09.2017 11:25:49
еще вариант (копирует выделенное в соседний столбец справа и там обрабатывает)
Код
Sub vvv()
Application.ScreenUpdating = False
Selection.Copy
Selection.Offset(, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
For Each t In Selection
n = InStr(t, Chr(10))
   With t.Characters(Start:=1, Length:=n).Font
        .FontStyle = "обычный"
        .Size = 9
   End With
   With t.Characters(Start:=n + 1, Length:=99).Font
        .FontStyle = "полужирный"
        .Size = 13
   End With
Next
Application.ScreenUpdating = True
End Sub
Изменено: V - 07.09.2017 11:28:11
 
 
 
#10
07.09.2017 11:29:45
Цитата
V написал:
еще вариант
о этот макрос сам и копирует отредактированные данные в соседний столбец...
Спасибо!!! :D  
 
 
 
#11
07.09.2017 11:42:56
На месте, без вн. цикла:
Код
Sub www()
    Dim c As Range, a
    With Selection
        a = .Value: .NumberFormat = "@": .Value = a
        .Font.Size = 10:
        For Each c In .Cells
            c.Characters(InStr(1, c, Chr(10)) + 1).Font.Size = 14
            c.Characters(InStr(1, c, Chr(10)) + 1).Font.Bold = True
        Next
    End With
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
Страницы: 1
Читают тему
Наверх