Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 След.
RSS
Как с помощью VBA добавить в ячейку текст с сохранением существуещего форматирования текста внутри ячейки?
 
Всем привет!

Есть ячейка A1, в которой содержатся строки с разным форматированием (см. вложение):
3. Жирный текст
2. Красный текст
1. Обычный текст

Как с помощью VBA в ячейку, в начало, добавить еще одну строку обычного текста, чтобы существующее форматирование не нарушилось, т.е. 3-я строка осталась жирной, 2-я Красной, а 1-я осталась без форматирования?
Уточнение: приведенное форматирование текста внутри ячейки это просто пример, т.е. на самом деле оно может быть произвольным.

Если я делаю так:

Код
Cells(1, 1).FormulaR1C1 = "4. Обычный текст" & Chr(10) & Cells(1, 1).FormulaR1C1 

то форматирование нарушается, становиться одинаковым для всей ячейки (т.е. для всего текста внутри ячейки).



РЕШЕНИЕ №1 от  Alec Perle,
в ответе #12:
Ограничение: работает только если в ячейке содержится не более 255 символов.

Код
ActiveCell.Characters(0, 0).Insert "Дополнительная строка" & Chr(10)

РЕШЕНИЕ №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.


Результат того, что мне было нужно в ответе #27.

cell.jpg (12.47 КБ)
Изменено: AnSo - 18 Окт 2019 09:41:35
 
Сначала добавить текст а потом форматировать по частям
 
Задача именно в том, чтобы сохранить существующее форматирование. Т.е. в боевых условиях я не знаю какое форматирование есть внутри ячейки, оно каждый раз разное. Все что мне нужно, добавить в эту ячейку текст, не изменяя (сохранив) существующее форматирование.
Руками такое сделать легко. Неужели нельзя через VBA?
 
Почему нельзя?
Считываете из ячейки параметры каждого символа (Font, Bold, Italic и пр.), добавляете новый текст, затем к старому тексту применяете считанные ранее параметры символов.
 
Цитата
RAN написал:
Считываете из ячейки параметры каждого символа
Спасибо за вариант. Но пока мне хочется думать, что предложенное Вами решение не единственное, поскольку оно мне ну очень не нравится.

Как Excel хранит форматирование текста внутри ячейки?
Предположу, что параметры форматирования он хранит не для каждого символа, а для каждого изменения формата. Что-то типа html: <b>жирный текст</b>. Если у меня текста в ячейке 100-200 символов, и я для каждого символа сделаю посимвольное форматирование, то размер форматирования превысит размер данных в ячейке :) Можно конечно программно одинаковое форматирование объединять в диапазоны, т.е. приводить к оригинальному виду, но это как-то сложновато выглядит для относительно простой операции.

Может все-таки есть более простой (правильный) способ?
 
Так Вам и не нужно знать форматирование каждого символа, ведь по условиям задачи форматирование одинаково для каждой строки. Достаточно запомнить форматирование первых символов строк, которое после изменения строки применить к нужным строкам
 
Цитата
Alec Perle написал:
ведь по условиям задачи форматирование одинаково для каждой строки
Возможно я не совсем корректно описал задачу, но я потом уточнил:
Цитата
Задача именно в том, чтобы сохранить существующее форматирование. Т.е. в боевых условиях я не знаю какое форматирование есть внутри ячейки, оно каждый раз разное.
Т.е. форматирование в постановке задачи это пример, чтобы показать, что при исполнении описанного мной скрипта (команды) оно (форматирование) сбрасывается. На самом же деле форматирование равно как и содержание ячейки может совершенно разным.
 
посмотрите это
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=114217&TITLE_SEO=114217-formatirovanie-simvolov-teksta-v-zavisimosti-ot-ikh-tsveta&tags=&q=xml+%D0%91%D0%BC%D0%B2&FORUM_ID%5B0%5D=0&DATE­_CHANGE=0&order=relevance&s=%D0%9D%D0%B0%D0%B9%D1%82%D0%B8

Просто Добавить в нужное место строки
Изменено: БМВ - 11 Окт 2019 11:56:32
 
Цитата
БМВ написал:
посмотрите это
Насколько я понял там есть два варианта:
1. Посимвольный перебор
2. Обработка xml.

Первый как я уже писал, мне не нравится.
А вот второй, вполне себе может подойти. Нужно время разобраться. Большое спасибо! Пошел разбираться :) По результатам постараюсь отписаться.

Если у кого-то будут еще варианты, буду рад услышать.
 
:)
Off
Добавить текст, снять копию экрана, распечатать. Раскрасить на бумаге текст, сделать фотографию, загрузить.
 
например
Код
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. Обычный текст&#10;</Font>" & Mid(sXml, p, 32768)
 Cells(1, 1).Value(xlRangeValueXMLSpreadsheet) = sXml
End Sub
 
Код
ActiveCell.Characters(0, 0).Insert "Дополнительная строка" & Chr(10)
 
Отличное решение! Все уже украдено продумано разработчиком до нас. :)  
Владимир
 
Цитата
Alec Perle написал:
ActiveCell.Characters(0, 0).Insert "Дополнительная строка" & Chr(10)
Это именно то, что я искал! Вопрос решен. Всем большое спасибо!
Alec Perle, Вам отдельное ОГРОМНОЕ спасибо!
 
Обнаружилась проблемка. Данное решение работает, если количество символов в целевой ячейке + количество добавляемых символов <= 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)
Изменено: sokol92 - 15 Окт 2019 13:44:00
Владимир
 
а  номеру 11  все нипочем
 
БМВ, это очень сильное колдунство)) что это, если вкратце?
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Jack Famous написал:
что это, если вкратце?
каждая ячейка имеет свою схему XML. Именно к ней обращаемся через Value(11). Далее просто вставляем текст с XML разметкой в нужное место и перезаписываем схему для ячейки.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, благодарю  ;)
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
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>

Т.е. изменился цвет. В других местах все сохранилось. Странь какая-то?! Почему так?
Изменено: AnSo - 15 Окт 2019 13:44:43
 
Цитата
AnSo написал:
ОГРОМНОЕ спасибо за предложенное решение!
это спасибо тем кто этому и меня научил, см  ссылку из #8
Цитата
AnSo написал:
что за число 32768?
просто бошльшое число,большее чем длина строки, там ваще должно быть 32767, но опечатался :-)

по 2 надо смотреть. Но я просто пример привел, как вариант обработки, возможно не самый лучший с точки зрения поиска что и куда вставить.
 
Цитата
БМВ: большее чем длина строки
дык а Mid же и так всё возьмёт, если 3ий аргумент опущен… Так быстрее?
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Jack Famous, Да это формальности. Я просто привык так.
 
Цитата
БМВ написал:
спасибо тем кто этому и меня научил, см  ссылку из #8
Плюс "первоисточник"
Владимир
 
sokol92, приветствую! Очень интересная штука — спасибо за ссылку!  :idea:

Попробовал 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

Проблему с цветом победить не удалось :(
Изменено: AnSo - 18 Окт 2019 09:52:58
 
Нашел еще одну багу/фичу, РЕШЕНИЯ 2:
2. Если целевая ячейка входила в диапазон(ы) условного форматирования, то после вставки целевая ячейка исключается из диапазона(ов) правил условного форматирования. Например, если для Cell(1, 1), на листе было правило условного форматирования =$B1>10, для диапазона =$1:$1000, то после вставки правило остается прежним, а диапазон изменяется на =$2:$1000;$B$1:$XFD$1, (ячейка 1.1 исключается).

Это можно как-то победить?
format.jpg (85.05 КБ)
Изменено: AnSo - 18 Окт 2019 09:51:55
 
AnSo, УФ ещё имеет свойство после добавления нового правила сбрасывать/восстанавливать порядок остальных правил, выставленный перед этим вручную… ХЗ как с этим бороться
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
AnSo написал:
после вставки целевая ячейка исключается из диапазона(ов) правил условного форматирования
Да, похоже, при любом присвоении свойства value ячейки с параметром xlRangeValueXMLSpreadsheet эта ячейка исключается из всех диапазонов действия правил условного форматирования.
Возможно, Вы - первооткрыватель этого эффекта.
Спасибо за интересную тему!
Владимир
Страницы: 1 2 След.
Читают тему (гостей: 1)
Наверх