Excel-儲存格內部分文字屬性操作

2010-07-02

10871
0
Office開發

Excel-儲存格內部分文字屬性操作

一、緣起：

最近一個專案，是關於以Excel資料作為圖文整合來源其中之一，不過中文有一些眉角是挺麻煩的，比如：

1、私書名號：

2、注音(含破音字)字體

這些東西尤其是針對小學生的讀物中，出現比例頗高，如何讓InDesign在圖文整合過程，認得那些字是要上私書名號、那些是要上注音字體，需有三方要素配合。

原先寄望Excel的搜尋取代功能，不過後來發現，Excel與Word不同，Excel可以處理儲存格內所有文字的屬性，卻不能處理部分文字的屬性，而且使用者後來還反映一個問題就是搜尋取代功能，會使被取代後面的文字屬性跑掉。

舉個簡單的例子，想把儲存格內分行符號，取代成『//』字串。

在幾經思考之後，必須使用最原始的處理方式，也就是針對逐個儲存格內的文字，逐字檢查其屬性，比如檢查到美國兩個有底線屬性時，便加以處理。

此處理模式，慢歸慢，但機器做總比人做來的好吧!

二、程式碼

底線文字，前面加上『~@C001-』，後面加上『@~』

刪除線文字，前面加上『~@C002-』，後面加上『@~』

特定字體，前面加上『~@CXXX-』，後面加上『@~』

『~@』指示InDesign Server在處理到這時，要注意開始套用特定樣式了。

『@~』指示InDesign Server套用作業到此結束。

『C001』表示在InDesign版型中對應的樣式名稱，C開頭表示字元樣式，P開頭表示段落樣式。

『-』區隔樣式代碼與文字內容。

公用變數


    Dim firstSym As String = "~@" '共通符 前符
    Dim lastSym As String = "@~" '共通符 尾符
    Dim sepSym As String = "-" ''共通符 區別符
    Dim theNameStyleCode As String = "C001" '私名號樣式碼
    Dim theBookStyleCode As String = "C002" '書名號樣式碼

    Dim thePhone1 As String = "C101" '華康寬注音(標楷W5)
    Dim thePhone2 As String = "C102" '華康寬破音一(標楷W5)
    Dim thePhone3 As String = "C103" '華康寬破音二(標楷W5)
    Dim thePhone4 As String = "C104" '華康寬破音三(標楷W5)
    Dim thePhone5 As String = "C105" '華康寬破音四(標楷W5)
    Dim thePhone6 As String = "C106" '華康寬破音五(標楷W5)

    Dim thePhone1_Name As String = "華康寬注音(標楷W5)"
    Dim thePhone2_Name As String = "華康寬破音一(標楷W5)"
    Dim thePhone3_Name As String = "華康寬破音二(標楷W5)"
    Dim thePhone4_Name As String = "華康寬破音三(標楷W5)"
    Dim thePhone5_Name As String = "華康寬破音四(標楷W5)"
    Dim thePhone6_Name As String = "華康寬破音五(標楷W5)"

底線文字處理


        Dim totalCount As Integer = 0 '計量
        Dim charsCount As Integer = 0 '收集字數
        Dim prevLineCode As String = "" '前字 線代號

        For v1 As Integer = sCell.Characters.Count To 1 Step -1
            Dim nowChars As Excel.Characters = sCell.Characters(v1, 1) '目前進行到的文字
            If nowChars.Font.Underline.ToString() <> prevLineCode Or v1 = 1 Then '目前文字底線代碼與上次紀錄的線型代碼不同
                '將該字前之連續字串位置及字數送入加工
                Dim preCharUnderLine As String = sCell.Characters(v1 + 1, 1).Font.Underline.ToString() '取得上一個字的底線代號
                If preCharUnderLine = "2" Then ' 如果底線代號為 2 ( 單底線 )
                    Dim startLocation As Integer = v1 + 1 '原則上開始的位置應該是目前字的前一個字
                    '如果是在儲存格內第一個字
                    If v1 = 1 Then '
                        startLocation = startLocation - 1 '則開始位置是目前這個字，不是前一個字，故開始位置要減1
                        charsCount += 1 '本字即時納入，不然會錯過
                    End If
                    '判斷代碼
                    Dim firstChar As Excel.Characters = sCell.Characters(startLocation, 1) '確定第一個是哪種線型
                    Dim rangeChars As Excel.Characters = sCell.Characters(startLocation, charsCount) '全字串
                    totalCount += rangeInsert(rangeChars, theNameStyleCode)
                End If
                charsCount = 1 '字數歸零 本字納入
                prevLineCode = nowChars.Font.Underline.ToString() '更新線碼
            Else '有接續
                charsCount += 1
            End If
            prevLineCode = sCell.Characters(v1, 1).Font.Underline.ToString() '紀錄線代號
        Next

刪除線文字處理


        Dim totalCount As Integer = 0 '計量
        Dim charsCount As Integer = 0 '集字數
        Dim prevStrikeStatus As String = "" '前字 刪除線狀態

        For v1 As Integer = sCell.Characters.Count To 1 Step -1
            Dim nowChars As Excel.Characters = sCell.Characters(v1, 1)
            If nowChars.Font.Strikethrough.ToString() <> prevStrikeStatus.ToString() Or v1 = 1 Then
                '該字前之連續字串位置及字數送入加工
                If prevStrikeStatus = "True" Then
                    Dim startLocation As Integer = v1 + 1
                    '儲存格內第一個字()
                    If v1 = 1 Then
                        startLocation = startLocation - 1 '起始位置是目前這個字，不是前一個字，故開始位置要減1
                        charsCount += 1 '本字即時納入
                    End If

                    '判斷代碼
                    Dim rangeChars As Excel.Characters = sCell.Characters(startLocation, charsCount) '全字串
                    totalCount += rangeInsert(rangeChars, theBookStyleCode)
                End If
                charsCount = 1 '字數歸零 本字納入
                prevStrikeStatus = nowChars.Font.Strikethrough.ToString() '更新狀態
            Else '有接續
                charsCount += 1
            End If
            prevStrikeStatus = sCell.Characters(v1, 1).Font.Strikethrough.ToString() '紀錄線代號
        Next

套用指定字體文字處理


        Dim totalCount As Integer = 0 '計量
        Dim charsCount As Integer = 0 '集字數
        Dim prevFontName As String = "" '前字 字體名稱

        For v1 As Integer = sCell.Characters.Count To 1 Step -1 '由後往前推
            Dim nowChars As Excel.Characters = sCell.Characters(v1, 1) '目前字元
            If nowChars.Font.Name.ToString() <> prevFontName Or v1 = 1 Then '目前字體名稱不等於前一個字體名稱
                '該字前之連續字串位置及字數送入加工
                Dim preCharFontName As String = sCell.Characters(v1 + 1, 1).Font.Name.ToString() '上一個字的字體名稱
                Dim startLocation As Integer = v1 + 1
                '如果是在儲存格內第一個字
                If v1 = 1 Then
                    startLocation = startLocation - 1 '起始位置是目前這個字，不是前一個字，故開始位置要減1
                    charsCount += 1 '本字即時納入
                End If
                '判斷代碼
                Dim firstChar As Excel.Characters = sCell.Characters(startLocation, 1) '第一個字要確定是哪種字體
                Dim rangeChars As Excel.Characters = sCell.Characters(startLocation, charsCount) '全字串

                Select Case firstChar.Font.Name.ToString()
                    Case thePhone1_Name
                        totalCount += rangeInsert(rangeChars, thePhone1)
                    Case thePhone2_Name
                        totalCount += rangeInsert(rangeChars, thePhone2)
                    Case thePhone3_Name
                        totalCount += rangeInsert(rangeChars, thePhone3)
                    Case thePhone4_Name
                        totalCount += rangeInsert(rangeChars, thePhone4)
                    Case thePhone5_Name
                        totalCount += rangeInsert(rangeChars, thePhone5)
                    Case thePhone6_Name
                        totalCount += rangeInsert(rangeChars, thePhone6)
                End Select
                'End If
                charsCount = 1 '字數歸零 本字納入
                prevFontName = nowChars.Font.Name.ToString() '更新線碼
            Else '有接續
                charsCount += 1
            End If
            prevFontName = sCell.Characters(v1, 1).Font.Name.ToString() '重記
        Next

指定文字串插文


    Function rangeInsert(ByVal rangeChars As Excel.Characters, ByVal styleName As String) As Integer
        If Trim(rangeChars.Text) = "" Then
            Return 0
        End If
        rangeChars.Insert(firstSym & styleName & sepSym & rangeChars.Text.ToString() & lastSym)
        Return 1
    End Function

回首頁