Добрый день, специалисты по экселю. Помогите решить проблему.
У меня на листе располагается ячейка E9 с текстом. Изначально текст в ячейке E9 - белого цвета - то есть он не виден.
Подскажите, как макросом заставить - постепенно, с задержкой в полсекунды в ячейке E9 - слева направо - менять цвет символов этого текста с белого на черный ?
(Таким образом - сперва появляется буква "п", затем "о", затем "н", затем "е", затем "д" и так далее - пока весь текст не станет видимым.)
Добрый день, специалисты по экселю. Помогите решить проблему.
У меня на листе располагается ячейка E9 с текстом. Изначально текст в ячейке E9 - белого цвета - то есть он не виден.
Подскажите, как макросом заставить - постепенно, с задержкой в полсекунды в ячейке E9 - слева направо - менять цвет символов этого текста с белого на черный ?
(Таким образом - сперва появляется буква "п", затем "о", затем "н", затем "е", затем "д" и так далее - пока весь текст не станет видимым.)cerber412
cerber412, а Вы понимаете что пока макрос будет рисовать буквы Excel будет занят и нельзя будет в нем работать? Посимвольно задавать параметры шрифта на сколько я знаю нельзя Можно
cerber412, а Вы понимаете что пока макрос будет рисовать буквы Excel будет занят и нельзя будет в нем работать? Посимвольно задавать параметры шрифта на сколько я знаю нельзя Можноdevilkurs
Сообщение отредактировал devilkurs - Среда, 15.03.2017, 14:37
Sub Posimv1() l = Len([a1]) For i = 1 To l Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = 122224 Application.Wait Time:=Now + TimeSerial(0, 0, 1) Next End Sub
[/vba]
Можно и посимвольно [vba]
Код
Sub Posimv1() l = Len([a1]) For i = 1 To l Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = 122224 Application.Wait Time:=Now + TimeSerial(0, 0, 1) Next End Sub
Sub devilkurs() Dim i% With Range("E9") .Font.Color = vbWhite For i = 1 To Len(.Value) .Characters(Start:=1, Length:=i).Font.Color = vbBlack Application.Wait Time:=Now + TimeSerial(0, 0, 1) Next End With End Sub
[/vba]
Не поспеешь за вами [vba]
Код
Sub devilkurs() Dim i% With Range("E9") .Font.Color = vbWhite For i = 1 To Len(.Value) .Characters(Start:=1, Length:=i).Font.Color = vbBlack Application.Wait Time:=Now + TimeSerial(0, 0, 1) Next End With End Sub
Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long) Sub iFont() Dim i As Integer Range("E7").Copy Range("E9") Range("E9").Font.ColorIndex = 2 Range("E9").Activate For i = 1 To Len(Range("E9")) With ActiveCell.Characters(i, 1).Font .ColorIndex = 1 Sleep 500 End With Next End Sub
[/vba]
[vba]
Код
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long) Sub iFont() Dim i As Integer Range("E7").Copy Range("E9") Range("E9").Font.ColorIndex = 2 Range("E9").Activate For i = 1 To Len(Range("E9")) With ActiveCell.Characters(i, 1).Font .ColorIndex = 1 Sleep 500 End With Next End Sub
Заинтересовались? Хорошо. У меня перекрашивается постепенно. Можно поиграть установками Sec. Если длина строки пополам - примерно полсекунды на букву. Если задать число, например, 3. Будет на все слово затрачено 3 секунды (для длинного слова каждая буква быстрее будет проявляться, для короткого - дольше).
Чтобы ответить на Ваш вопрос, нужен файл, в котором Вы, выделив E9 нажимаете кнопку. Может кнопке там по ошибке вовсе не мой макрос назначен?
Если, правда, в моем коде глюк, готов смотреть и править.
Сейчас проверил. Не работает, если в ячейке результат вычисления формулы, а не значение. Но тогда никакой, скорее всего, из предложенных, не взял бы такую планку.
С уважением.
Заинтересовались? Хорошо. У меня перекрашивается постепенно. Можно поиграть установками Sec. Если длина строки пополам - примерно полсекунды на букву. Если задать число, например, 3. Будет на все слово затрачено 3 секунды (для длинного слова каждая буква быстрее будет проявляться, для короткого - дольше).
Чтобы ответить на Ваш вопрос, нужен файл, в котором Вы, выделив E9 нажимаете кнопку. Может кнопке там по ошибке вовсе не мой макрос назначен?
Если, правда, в моем коде глюк, готов смотреть и править.
Сейчас проверил. Не работает, если в ячейке результат вычисления формулы, а не значение. Но тогда никакой, скорее всего, из предложенных, не взял бы такую планку.
Точно! У Вас там формула стояла! Конкретно под Ваши нужды. Даже если будет формула массива - в конце вернет и оставит формулой массива: [vba]
Код
Sub chColorTxt() Dim Sec As Double, lR As Long, R As Long, strIn As String, strInM As String
Set cc = ActiveCell If ActiveCell.HasArray Then strInM = ActiveCell.FormulaArray Else strIn = ActiveCell.Formula End If ActiveCell.Value = ActiveCell.Value lR = Len(ActiveCell.Value) ' Sec = Len(ActiveCell.Value) / 2 Sec = 5
ActiveCell.Font.ColorIndex = 2 dBeg = Date tBeg = (Date - dBeg) * 86400 + Timer tEnd = tBeg + Sec Do t = (Date - dBeg) * 86400 + Timer R = 1 + (lR - 1) * (t - tBeg) / Sec ActiveCell.Characters(Start:=R, Length:=1).Font.ColorIndex = xlAutomatic DoEvents Loop While ((Date - dBeg) * 86400 + Timer) < tEnd ActiveCell.Font.ColorIndex = xlAutomatic If Len(strInM) Then ActiveCell.FormulaArray = strInM Else ActiveCell.Formula = strIn End If
End Sub
[/vba]
Точно! У Вас там формула стояла! Конкретно под Ваши нужды. Даже если будет формула массива - в конце вернет и оставит формулой массива: [vba]
Код
Sub chColorTxt() Dim Sec As Double, lR As Long, R As Long, strIn As String, strInM As String
Set cc = ActiveCell If ActiveCell.HasArray Then strInM = ActiveCell.FormulaArray Else strIn = ActiveCell.Formula End If ActiveCell.Value = ActiveCell.Value lR = Len(ActiveCell.Value) ' Sec = Len(ActiveCell.Value) / 2 Sec = 5
ActiveCell.Font.ColorIndex = 2 dBeg = Date tBeg = (Date - dBeg) * 86400 + Timer tEnd = tBeg + Sec Do t = (Date - dBeg) * 86400 + Timer R = 1 + (lR - 1) * (t - tBeg) / Sec ActiveCell.Characters(Start:=R, Length:=1).Font.ColorIndex = xlAutomatic DoEvents Loop While ((Date - dBeg) * 86400 + Timer) < tEnd ActiveCell.Font.ColorIndex = xlAutomatic If Len(strInM) Then ActiveCell.FormulaArray = strInM Else ActiveCell.Formula = strIn End If