VBA Excel 2013标题/热线操作

时间:2016-10-12 10:36:59

标签: excel vba excel-vba header formatting

我目前正在开发一个VBA工具,可以自动为其中的所有项目设置Excel文档中的标题和标题,当文档打开并且用户可以从其他文档中导入head和footline时,它会打开,写入它在gui窗口的字段中。 为了防止用户只需要进行少量更改就必须输入所有内容,窗口中的所有值都已填入当前文档。

我现在的问题是,我不知道如何将传入的字符串拆分为格式部分和实际显示的文本部分(不需要将格式化部分自身拆分)。

到目前为止,我使用Replace()来简单地删除已知的格式部分并在最后手动添加它们,但是不会为不同的标题剪切它。

使用For循环切断&处的传入字符串。符号失败,因为一旦用户可以使用标题和&符号和最后一种格式直接与实际文本一致(& K03 + 039附录一个颜色变量,通向标题部分附录)

我也不能使用表格本身的任何部分,因为这对所有类型的表格都是通用的。

所以我想知道是否有办法将标题字符串拆分为实际的文本部分和格式化部分。

我能想出的每种格式的输入字符串都是这样的: &" Algerian,Fett"& 14& S& X& K03 + 039附录C - Opera 附录C - Opera是标题。

感谢您提前获得帮助

1 个答案:

答案 0 :(得分:0)

好的,我现在为我的问题开发了一个解决方案,对我有用,它不漂亮但有效。

它可以将给定的字符串拆分为格式化部分和文本部分,但它不能与&&amp ;;在标题内,在使用此方法之前需要注意。

它也不知道页码的格式,因为我不需要它,但可以很容易地修复。

Public FullLine As SeperatedLineParts

私有函数InformationHandler(text as String)     设置FullLine = New SeperatedColumnParts     Dim param As String     Dim textPart As String     Dim co As Integer

'Stops the function when "text" is empty
If text = "" Then
    FullLine.text = text
    FullLine.format = ""
    Exit Function
End If





'Splits the incoming "text" in single Symbols
Dim singleSymbols() As String
ReDim singleSymbols(Len(text) - 1)
For co = 1 To Len(text)
    singleSymbols(co - 1) = Mid$(text, co, 1)
Next



'switch case variables, helper for seperating the "text"
Dim isParam As String   ' Boolean Value as a String, to use it for the switch cases
Dim wasText As Boolean  ' Remembers if the last part was a textpart or a format part, if it was a text and now a format part is following, they will be sepperated
isParam = "False"       ' Remembers if the current Symbol is a textpart or a format part
wasText = False
FullLine.parts = 1      ' remembers the number of parts with different formats

' This loop splits Format and Textparts and writes a Chr(3)||Chr(2) Marker between the different formatted parts
For co = 0 To UBound(singleSymbols)
    Select Case singleSymbols(co) + isParam

    Case Chr(38) + "False"          ' If a & symbol appears it will start a new parameter except if another & follows (&&)
        If singleSymbols(co + 1) = Chr(38) Then
        textPart = textPart + "&&"
        co = co + 1
        isParam = "False"
        Else

        If wasText = True Then      ' If a & follows after a textsegment a new part will be created except when another & follows (&&)
            textPart = textPart + Chr(3) + "||" + Chr(2)               ' Chr(3) and Chr (2) arte the permitter  and  that split a following formatpart from a leading textpart
            param = param + Chr(3) + "||" + Chr(2)
            FullLine.parts = FullLine.parts + 1
            wasText = False
        End If

        isParam = "True"
        param = param + "&"
        End If


    ' Identifies all single letter commands
    Case "L" + "True", "C" + "True", "R" + "True", "I" + "True", "E" + "True", "X" + "True", "Y" + "True", "B" + "True", "U" + "True", "S" + "True", "D" + "True", "T" + "True", "F" + "True", "A" + "True", "N" + "True", "Z" + "True", "G" + "True"
        param = param + singleSymbols(co)
        isParam = "False"

    ' Identifies all size commands
    Case "1" + "True", "2" + "True", "3" + "True", "4" + "True", "5" + "True", "6" + "True", "7" + "True", "8" + "True", "9" + "True"
        param = param + singleSymbols(co)
        If IsNumeric(singleSymbols(co + 1)) Then
            co = co + 1
            param = param + singleSymbols(co)
        End If
        isParam = "False"


    Case Chr(34) + "True"           ' If the " symbol appears at the beginning of a command it will be a longer command till another " symbol ends it
        Dim coun As Integer
        param = param + singleSymbols(co)
        For coun = co + 1 To UBound(singleSymbols)
            param = param + singleSymbols(coun)
            If singleSymbols(coun) = Chr(34) Then
                co = coun
                coun = UBound(singleSymbols)
            End If
        Next
        isParam = "False"


    Case "K" + "True"               ' Identifies all color commands
        param = param + singleSymbols(co)
        For coun = 1 To 6
            param = param + singleSymbols(coun + co)
        Next
        co = co + 6
        isParam = "False"


    Case Else                       ' Identifies all normal text symbols
        textPart = textPart + singleSymbols(co)
        wasText = True

    End Select
Next

' Writes the format and the text parts into the "FullLine" object, wich now contains these parameters as well as the number of parts
FullLine.format = param
FullLine.text = text
End Function


'Function for making a string out of an array while shorten it at the beginning for the given amount
Private Function ArrToString(inpu() As String, shortenBy As Integer) As String
    Dim i As Integer
    For i = shortenBy + 1 To UBound(inpu)
        ArrToString = ArrToString + inpu(i)
    Next

End Function

我知道这是一个怪物,可能会伤害每一位经验丰富的程序员,但这是迄今为止我能想到的最好的。

编辑:它仍有一个问题,即如果文本中有格式符号,它将只将最后一个文本部分作为文本,格式部分之间的所有内容也将被视为格式。

有没有更有效的方法来完成这项工作。

编辑:重新设计了整个功能,它现在能够处理文本中的格式更改和&&,并且评论也得到了改进,使其可以为其他用户更改。

还要编写一个类模块:

Option Explicit
Public parts As Integer
Public format As String
Public text As String

使功能发挥作用。

编辑:Chr(3)和Chr(4)符号在这一方面不起作用,并且您在输出中应该看到的示例注释不会显示它们,因此您的结果将不同于这里显示。 对于所有重要的事项,这些符号是excel中任何标题都不太可能使用的符号,并且可以在不对代码的其余部分进行任何进一步更改的情况下进行更改。