AnSo (Автор тем)

Как с помощью VBA добавить в ячейку текст с сохранением существуещего форматирования текста внутри ячейки?

Пользователь

Сообщений: 15 Регистрация: 20.03.2017

10.10.2019 17:21:32

Всем привет!

Есть ячейка 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.

Изменено: AnSo - 18.10.2019 09:41:35

Перейти

VBA Excel+Outlook 2013. Ошибка при отправке сохраненных писем.

AnSo

Пользователь

Сообщений: 15 Регистрация: 20.03.2017

20.03.2017 11:06:27

Добрый день.

Есть необходимость из Excel осуществлять отправку ранее сохраненных писем (папка "Черновики"). Код отправки см. ниже. Код работает, НО если перед отпавкой в Оутлуке открыть папку Черновики и выбрать любое сообщение (не открыть, а просто "встать" на него), то часть писем не отправиться и при отправке будет выдана ошибка: Run-time error ... "Этот метод нельзя использовать со встроенным элементом отправки почты".
Что это значит? Почему так происходит? И как это можно победить?

Код

Sub SendSaved()
    Dim oOutApp As Outlook.Application
    Dim oNamespace As Outlook.Namespace
    Dim oFolder As Outlook.MAPIFolder
    Dim oMail As Outlook.MailItem
    Dim i As Long
    
    Set oOutApp = GetObject(, "Outlook.Application")
    Set oNamespace = oOutApp.GetNamespace("MAPI")
    Set oFolder = oNamespace.GetDefaultFolder(olFolderDrafts)
    
    For i = 1 To oFolder.Items.Count
        Set oMail = oFolder.Items.Item(i)
         oMail.Send
        Set oMail = Nothing
    Next

    Set oFolder = Nothing
    Set oNamespace = Nothing
    Set oOutApp = Nothing
End Sub

Заранее, большое спасибо!

Изменено: AnSo - 20.03.2017 11:19:20

Перейти