Форматирование ячеек

Question

Короткий вопрос относительно форматирования Excel.

В настоящее время я работаю над инструментом протокола на основе пользовательской формы. Пользовательская форма в основном состоит из двух входных окон, одна из которых загружает текущие точки маркера и одну для добавления новых точек.

Кроме того, я хотел бы добавить дату, выделенную жирным шрифтом, добавленную к каждой точке маркера. Я реализовал это, выполнив поиск позиции в строке, где встречается дата (через instrrev), а затем сменив шрифт на следующие 10 символов на полужирный шрифт.

Теперь он отлично работает при создании новой отметки, но он всегда беспорядочен, когда я добавляю дополнительную точку в существующую тему или когда я меняю старую маркерную точку (тогда весь текст выделен жирным шрифтом). Кто-нибудь знает, почему это происходит?

Private Sub Fertig_Click() 
    Dim neu As String 
    Dim i As Integer 
    neu = Date & ": " & mitschrieb_neu.Value 


    'No Changes 
    If mitschrieb_neu.Value = "" And mitschrieb_alt.Value = ActiveCell.Value Then 
     Unload Me 
     Exit Sub 
    End If 

    'First bullet point 
    If mitschrieb_neu.Value <> "" And ActiveCell.Value = "" Then 
     ActiveCell.Value = neu 
     i = InStrRev(ActiveCell.Value, Date) 
     ActiveCell.Characters(i, 10).Font.Bold = True 
     Unload Me 
     Exit Sub 
    End If 

    'New bullet point 
    If mitschrieb_neu.Value <> "" And ActiveCell.Value <> "" Then 
     ActiveCell.Value = ActiveCell.Value & Chr(10) & neu 
     i = InStrRev(ActiveCell.Value, Date) 
     ActiveCell.Characters(i, 10).Font.Bold = True 
     Unload Me 
     Exit Sub 
    End If 

    'Changed an old bullet point 
    If mitschrieb_neu.Value = "" And mitschrieb_alt.Value <> ActiveCell.Value Then 
     ActiveCell.Value = mitschrieb_alt.Value 
     Unload Me 
     Exit Sub 
    End If 

End Sub 

Answer 1

После того, как вы выполните это:

ActiveCell.Value = ActiveCell.Value & Chr(10) & neu 

Установка Bold для ячейки становится однородным - он стирает любые знания подстроки форматирования.

Таким образом, решение состоит в анализе полного значения в цикле и определении всех дат и их смещении.

В то же время я хотел бы предложить какой-нибудь способ, чтобы уменьшить дублирование кода и объединить все различные случаи (первая пуля, а не первая пуля, только модификация) в один общий путь:

Private Sub Fertig_Click() 
    Dim neu As String 
    Dim i As Integer 

    'No Changes 
    If mitschrieb_neu.Value = "" And mitschrieb_alt.Value = ActiveCell.Value Then 
     Unload Me 
     Exit Sub 
    End If 

    ' Join the old value with the new value and put a linefeed 
    ' in between only if both are not empty. 
    ' Also insert the date before the new value, if it is not empty 
    ActiveCell.Value = mitschrieb_alt.Value _ 
     & IIf(mitschrieb_alt.Value <> "" And mitschrieb_neu.Value <> "", Chr(10), "") _ 
     & IIf(mitschrieb_neu.Value <> "", Date & ": " & mitschrieb_neu.Value, "") 

    ActiveCell.Font.Bold = False ' start with removing all bold 
    ' Search for all colons and put prededing date in bold (if it is a date) 
    i = InStr(ActiveCell.Value, ": ") 
    Do While i 
     ' Make sure to only put in bold when it is a date, otherwise skip this ":" 
     If i > 10 And IsDate(Mid(ActiveCell.Value, i - 10, 10)) Then 
      ActiveCell.Characters(i - 10, 10).Font.Bold = True 
     End If 
     ' find next 
     i = InStr(i + 1, ActiveCell.Value, ": ") 
    Loop 

    Unload Me 
End Sub