Есть ячейка A1, в которой содержатся строки с разным форматированием (см. вложение): 3. Жирный текст 2. Красный текст 1. Обычный текст
Как с помощью VBA в ячейку, в начало, добавить еще одну строку обычного текста, чтобы существующее форматирование не нарушилось, т.е. 3-я строка осталась жирной, 2-я Красной, а 1-я осталась без форматирования? Уточнение: приведенное форматирование текста внутри ячейки это просто пример, т.е. на самом деле оно может быть произвольным.
РЕШЕНИЕ №2 от БМВ, в ответе #11: Ограничения: 1. В процессе вставки подменяются некоторые цвета текста внутри ячейки, например стандартный зеленый #00B050. 2. Если на листе используется условное форматирование, то после вставки целевая ячейка исключается из диапазонов существующих условий условного форматирования.
Код
Sub insertText()
sXml = Cells(1, 1).Value(xlRangeValueXMLSpreadsheet)
sXml = Application.Trim(Replace$(Replace$(Replace$(sXml, vbCrLf, " "), vbLf, " "), vbCr, " "))
s = "Type=""String"" xmlns=""http://www.w3.org/TR/REC-html40"">"
p = InStr(sXml, s) + Len(s)
sXml = Left(sXml, p - 1) & "<Font html:Color=""#000000"">4. Обычный текст
</Font>" & Mid(sXml, p, 32768)
Cells(1, 1).Value(xlRangeValueXMLSpreadsheet) = sXml
End Sub
ОГРОМНОЕ СПАСИБО: Alec Perle (Решение1), БМВ (Решение 2), Jack Famous (комментарий про MID) и конечно автору первоисточника - ZVI.
Задача именно в том, чтобы сохранить существующее форматирование. Т.е. в боевых условиях я не знаю какое форматирование есть внутри ячейки, оно каждый раз разное. Все что мне нужно, добавить в эту ячейку текст, не изменяя (сохранив) существующее форматирование. Руками такое сделать легко. Неужели нельзя через VBA?
Почему нельзя? Считываете из ячейки параметры каждого символа (Font, Bold, Italic и пр.), добавляете новый текст, затем к старому тексту применяете считанные ранее параметры символов.
RAN написал: Считываете из ячейки параметры каждого символа
Спасибо за вариант. Но пока мне хочется думать, что предложенное Вами решение не единственное, поскольку оно мне ну очень не нравится.
Как Excel хранит форматирование текста внутри ячейки? Предположу, что параметры форматирования он хранит не для каждого символа, а для каждого изменения формата. Что-то типа html: <b>жирный текст</b>. Если у меня текста в ячейке 100-200 символов, и я для каждого символа сделаю посимвольное форматирование, то размер форматирования превысит размер данных в ячейке Можно конечно программно одинаковое форматирование объединять в диапазоны, т.е. приводить к оригинальному виду, но это как-то сложновато выглядит для относительно простой операции.
Может все-таки есть более простой (правильный) способ?
Так Вам и не нужно знать форматирование каждого символа, ведь по условиям задачи форматирование одинаково для каждой строки. Достаточно запомнить форматирование первых символов строк, которое после изменения строки применить к нужным строкам
Alec Perle написал: ведь по условиям задачи форматирование одинаково для каждой строки
Возможно я не совсем корректно описал задачу, но я потом уточнил:
Цитата
Задача именно в том, чтобы сохранить существующее форматирование. Т.е. в боевых условиях я не знаю какое форматирование есть внутри ячейки, оно каждый раз разное.
Т.е. форматирование в постановке задачи это пример, чтобы показать, что при исполнении описанного мной скрипта (команды) оно (форматирование) сбрасывается. На самом же деле форматирование равно как и содержание ячейки может совершенно разным.
Насколько я понял там есть два варианта: 1. Посимвольный перебор 2. Обработка xml.
Первый как я уже писал, мне не нравится. А вот второй, вполне себе может подойти. Нужно время разобраться. Большое спасибо! Пошел разбираться По результатам постараюсь отписаться.
Если у кого-то будут еще варианты, буду рад услышать.
Обнаружилась проблемка. Данное решение работает, если количество символов в целевой ячейке + количество добавляемых символов <= 255. Если символов больше, то не работает - ошибок не выдает, просто не добавляет текст. MS Excel 2013 x86, на других не проверял. Формат ячейки пробовал: "Обычный" и "Текст". Руками добавляется без проблем.
Возможно ли обойти это ограничение? Если да, то как?
Excel вообще крайне нестабильно работает с форматированием отдельных символов ячейки - об этом были темы на форуме. Метод Characters.Insert, похоже, имеет указанное в #15 ограничение по длине результата в 255 символов (не он один). Если открыть новую книгу и выполнить следующий макрос:
Код
Sub test()
ActiveCell.Value = String(300, "a")
ActiveCell.Characters(1, 0).Insert "Дополнительный текст"
End Sub
то возникает ошибка "Метод Insert из класса Characters завершен неверно".
Если в книге произвести какое-нибудь форматирование отдельных символов, то указанный выше макрос уже не вызывает ошибку, но и не вставляет символы (как также указано в #15). Явная ошибка Excel. Тестировалось на конфигурации: Win 10 Excel 2016(32-, ru)
БМВ, это очень сильное колдунство)) что это, если вкратце?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
каждая ячейка имеет свою схему XML. Именно к ней обращаемся через Value(11). Далее просто вставляем текст с XML разметкой в нужное место и перезаписываем схему для ячейки.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: БМВ , это очень сильное колдунство)) что это, если вкратце?
Для себя откомментировал код. Может кому пригодиться:
Код
Sub AddTextInCell()
' Получаем содержимое ячейки в формате XML
sXml = Cells(1, 1).Value(xlRangeValueXMLSpreadsheet)
' Насколько я понял, заменяем переносы строк пробелами, для того чтобы корректно отработал поиск нужной подстроки
sXml = Application.Trim(Replace$(Replace$(Replace$(sXml, vbCrLf, " "), vbLf, " "), vbCr, " "))
' Формируем строку для поиска, сразу после данного текста в XML идут данные содержащиеся в ячейке
s = "Type=""String"" xmlns=""http://www.w3.org/TR/REC-html40"">"
' Определяем позицию в тексте XML с которой начинаются данные ячейки =
' позиция начиная с которой нашли строку поиска "s" + длина строки поиска
p = InStr(sXml, s) + Len(s)
' добавляем нужные нам данные в xml, для этого:
' берем левую часть исходного XML до данных в ячейке + добавляем нужный нам текст (здесь добавлено еще форматирование текста - выделение черным цветом)
' + добавляем правую часть исходного XML начиная с данных содержащихся в ячейке.
sXml = Left(sXml, p - 1) & "<Font html:Color=""#000000"">4. Добавляемый текст
</Font>" & Mid(sXml, p, 32768)
' записываем получившийся XML в ячейку
Cells(1, 1).Value(xlRangeValueXMLSpreadsheet) = sXml
End Sub
БМВ, ОГРОМНОЕ спасибо за предложенное решение! Оно действительно работает.
Вопросы: 1. Вот это немного смущает: Mid(sXml, p, 32768). Что за число 32768? Максимальный размер данных (в формате XML) в ячейке? 2. После отработки данной процедуры, почему то, вот эта строка данных в XML:
Код
html:Color="#00B050">ttt</Font>
заменилась на
Код
html:Color="#008080">ttt</Font>
Т.е. изменился цвет. В других местах все сохранилось. Странь какая-то?! Почему так?
дык а Mid же и так всё возьмёт, если 3ий аргумент опущен… Так быстрее?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
sokol92, приветствую! Очень интересная штука — спасибо за ссылку!
Попробовал Selection.Value(xlRangeValueMSPersistXML) (без тэгов форматирования) на диапазоне A11:B13 (см. скрин) — как я понимаю, польза такого метода только для чтения/записи параметров текста. Надеялся ещё что-то "вытянуть" типа номеров строк/столбцов)))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
' Функция добавляет текст в ячейку, формата "Текстовый" или "Общий"(содержащий хотя бы одну букву),
' содержащую данные, не изменяя формат содержимого текста. Текст добавляется в начало.
' Функция возвращает:
' True - если добавление прошло успешно,
' False - если произошла ошибка при добавлении.
' Данные в ячейку НЕ добавятся (результат будет False) если:
' - ячейка в которую добавляются данные пуста,
' - добавляемый текст - пустой
' - формат ячейки в котороую производится вставка НЕ "Текстовый" или "Общий"(содержащий хотя бы одну букву)
' - произошла ошибка поиска тега Data
' Известные проблемы:
' 1. В процессе вставки подменяются некоторые цвета, например:
' если в ячейке был фрагмент выделенный зеленым цветом #00B050,
' то после добавления цвет меняется на #008080.
' 2. Если целевая ячейка входила в диапазон(ы) условного форматирования, то после вставки
' целевая ячейка исключается из диапазона(ов) правил условного форматирования.
' Например, если для Cell(1, 1), на листе было правило условного форматирования =$B1>10, для диапазона =$1:$1000,
' то после вставки правило остается прежним, а диапазон изменяется на =$2:$1000;$B$1:$XFD$1, (ячейка 1.1 исключается).
Function AddTextInCell(TargetCell As Range, sAddString As String) As Boolean
Dim sXML As String
Dim p As Long
Dim pData As Long
AddTextInCell = False
' Если нечего добавлять - выходим
If sAddString = "" Then Exit Function
' Получаем содержимое целевой ячейки в формате XML
sXML = TargetCell.Value(xlRangeValueXMLSpreadsheet)
' Заменяем переносы строк пробелами, для того чтобы корректно отработал поиск нужной подстроки
sXML = Application.Trim(Replace$(Replace$(Replace$(sXML, vbCrLf, " "), vbLf, " "), vbCr, " "))
' Определяем позицию в тексте XML с которой начинается тэг данных
p = InStr(sXML, "Data")
' Если тег есть
If p Then
' Ищем позицию окончание тэга Data, т.е. закрывающую часть ">"
pData = InStr(p, sXML, ">")
If pData Then
' Проверяем что формат ячейки Текстовый или Общий (в ячейке есть буква):
' внутри тега Data ищем слово String
If InStr(Mid(sXML, p, pData - p), "String") > 0 Then
' добавляем нужные нам данные в xml, для этого:
' берем левую часть исходного XML до данных в ячейке + добавляем нужный нам текст
' + добавляем правую часть исходного XML начиная с данных содержащихся в ячейке.
sXML = Left(sXML, pData) & sAddString & Mid(sXML, pData + 1)
' записываем получившийся XML в ячейку
TargetCell.Value(xlRangeValueXMLSpreadsheet) = sXML
' Возвращаем True
AddTextInCell = True
End If
End If
End If
End Function ' AddTextInCell(TargetCell As Range, sAddString As String) As Boolean
Нашел еще одну багу/фичу, РЕШЕНИЯ 2: 2. Если целевая ячейка входила в диапазон(ы) условного форматирования, то после вставки целевая ячейка исключается из диапазона(ов) правил условного форматирования. Например, если для Cell(1, 1), на листе было правило условного форматирования =$B1>10, для диапазона =$1:$1000, то после вставки правило остается прежним, а диапазон изменяется на =$2:$1000;$B$1:$XFD$1, (ячейка 1.1 исключается).
AnSo, УФ ещё имеет свойство после добавления нового правила сбрасывать/восстанавливать порядок остальных правил, выставленный перед этим вручную… ХЗ как с этим бороться
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
AnSo написал: после вставки целевая ячейка исключается из диапазона(ов) правил условного форматирования
Да, похоже, при любом присвоении свойства value ячейки с параметром xlRangeValueXMLSpreadsheet эта ячейка исключается из всех диапазонов действия правил условного форматирования. Возможно, Вы - первооткрыватель этого эффекта. Спасибо за интересную тему!