将格式化的项目符号导出到Excel TextBox

时间:2017-09-21 11:29:15

标签: html excel excel-vba outlook vba

我一直在制作电子表格,以便我的团队能够更有效地管理我们的工作量,同时业务正在开发新工具。无论如何,工作表所做的是注入信息,然后点击一个按钮,它会填充一个OFT电子邮件模板,以便发送信息。

问题是,我们在很大程度上依赖于电子邮件的子弹列表,我真的很难找到一种从ActiveX文本框中有效添加项目符号的方法。

目前,我有一个按钮,可以将后续内容添加到文本框中:

[子弹] *子弹1 *子弹2 *子弹3 [/子弹]

然后我有替换查找字符串的语句,并用适当的HTML标记替换它们。这是代码:

' Add HTML formatting to text updates so it displays correctly in the email.
LatestUpdate.Text = Replace(LatestUpdate, "[bullets]", "<ul>")
LatestUpdate.Text = Replace(LatestUpdate, "[/bullets]", "</ul>")
LatestUpdate.Text = Replace(LatestUpdate, "* ", "<li>")
LatestUpdate.Text = Replace(LatestUpdate, vbCrLf, "<br>")

我遇到的问题是,非技术人员正在使用这个文档,所以我真的想以这样的方式拥有它,如果他们不必看标记,但可以简单地添加子弹直接来自文本框。

我原本打算用“&lt; li&gt;”替换“*”但是,这并没有添加正确的&lt; ul&gt;标签,所以它实际上并不是电子邮件中的项目符号列表。

有人可以帮助为最终用户简化此过程吗?我真的被卡住了。

圣杯将在文本框中启用丰富的文本格式,但我不相信我所做的所有研究都可以实现这一点吗?

TIA。

1 个答案:

答案 0 :(得分:0)

根据您的上一条评论,您要查找的内容不仅仅是文本框中的项目符号,还有缩进项。所以这是一次尝试:

首先在<textbox>_KeyUp函数中添加以下内容:

Private Sub txtBulletPoints_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim STRING_LENGTH As Long: STRING_LENGTH = 49
    Dim aLine() As String
    Dim aLineSpace() As String
    Dim iC As Integer
    Dim sText As String
    Dim bUpdate As Boolean

    ' Only do this if there is a string to work with
    If Len(Me.txtBulletPoints.Text) > 0 Then

        ' Set initial values
        aLine = Split(Me.txtBulletPoints.Text, vbCrLf)
        bUpdate = False

        ' First lets indent the last line if we need to
        If Left(aLine(UBound(aLine)), 2) = "- " Then
            For iC = LBound(aLine) To UBound(aLine)
                If iC = UBound(aLine) Then
                    sText = sText & vbTab & aLine(iC)
                Else
                    sText = sText & aLine(iC) & vbCrLf
                End If
            Next

            Me.txtBulletPoints.Text = sText

        End If

        ' Now the tricky bit. Check if we have reached the end of the
        ' line so that we can indent the text into the next line
        If (Len(aLine(UBound(aLine))) >= STRING_LENGTH) And (InStr(1, aLine(UBound(aLine)), vbTab) = 1) Then
            For iC = LBound(aLine) To UBound(aLine)
                If iC = UBound(aLine) Then
                    aLineSpace = Split(aLine(iC), " ")

                    ' As we have to indent the last bullet point line, call the finction to do that
                    sText = sText & SetIndentsInString(aLine(iC), STRING_LENGTH)

                Else
                    sText = sText & aLine(iC) & vbCrLf
                End If
            Next

            Me.txtBulletPoints.Text = sText

        End If

    End If

End Sub

现在在表单代码所在的位置添加以下UDF(基本上与<textbox>_KeyUp函数所在的位置相同):

Function SetIndentsInString(ByVal sString As String, ByVal iIndentLen As Long) As String
    Dim iC As Long
    Dim iLastTab As Long: iLastTab = 0
    Dim aSpace() As String
    Dim aTab() As String
    Dim sCurString As String

    ' Check if the string is the same as what it was last
    ' time (sLastString is a private module variable initialised
    ' to "" when the form is activated)
    If Replace(sString, vbTab, "") = Replace(sLastString, vbTab, "") Then
        ' Its the same string so lets return it as is
        SetIndentsInString = sString
    Else
        ' Its not the same string so set initial values
        sLastString = sString
        SetIndentsInString = ""

        ' Loop to see how many lines we have based on number of TABs in the string
        Do While InStr(iLastTab + 1, sString, vbTab) > 0
            iLastTab = iLastTab + InStr(iLastTab + 1, sString, vbTab)
        Loop

        ' If there is only 1 TAB, simply indent the line
        If iLastTab = 1 Then
            aSpace = Split(sString, " ")
            SetIndentsInString = Mid(sString, 1, Len(sString) - Len(aSpace(UBound(aSpace)))) & vbTab & "  " & aSpace(UBound(aSpace))
        Else

            ' More then 1 TAB.. damn!. Ok well lets work it
            aTab = Split(sString, vbTab)
            sCurString = aTab(UBound(aTab))

            ' Check if the last line of our bullet point has more characters then allowed in a line
            If Len(sCurString) >= iIndentLen Then

                ' It does. Now loop through all the lines in our bullet point and set the last character in a new line with indent
                aSpace = Split(sCurString, " ")
                For iC = LBound(aTab) To UBound(aTab)
                    If iC = UBound(aTab) Then
                        SetIndentsInString = SetIndentsInString & Mid(sCurString, 1, Len(sCurString) - Len(aSpace(UBound(aSpace)))) & vbTab & "  " & aSpace(UBound(aSpace))
                    Else
                        SetIndentsInString = SetIndentsInString & aTab(iC) & vbTab
                    End If
                Next

            Else

                ' It doesnt. Loop through and send the string back
                SetIndentsInString = sString

            End If

        End If

    End If

End Function

现在在同一模块中,在顶部进行以下声明:

Private sLastString As String

基本上,上面的内容将 like 一个子弹点,就像它在富文本框中一样。要记住的是,您必须将STRING_LENGTH设置为文本框在给定项目符号线中所占用的字符数(您必须使用它)。下面是它如何为我工作的丝网印刷 enter image description here