单元格格式

Question

关于 excel 格式的简短问题。

我目前正在开发基于用户表单的协议工具。用户窗体基本上由两个输入 windows 组成，一个用于加载现有的项目符号点，一个用于添加新点。

此外，我想在每个要点中添加粗体日期。我通过搜索字符串中日期出现的位置（通过 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

单元格格式

Cell Formatting

excel

vba

userform