VB实现上下标

Module Module1

    Private suptable As Hashtable
    Private subtable As Hashtable

    Sub Main(ByVal Args() As String)
        implementSubAndSup(Args(0))
    End Sub

    Private Sub implementSubAndSup(ByVal excelName As String)
        If (excelName.Length > 0) Then
            Dim excelApp As Microsoft.Office.Interop.Excel.Application
            Dim excelBook As Microsoft.Office.Interop.Excel.Workbook
            Dim excelsheet As Microsoft.Office.Interop.Excel.Worksheet '定义工作表类

            Try
                excelBook = New Microsoft.Office.Interop.Excel.Workbook()
            Catch ex As Exception

            End Try

            excelApp = CreateObject("Excel.Application")
            excelApp.DisplayAlerts = False
            Try
                excelBook = excelApp.Workbooks.Open(excelName)
            Catch ex As Exception
                '  System.Console.WriteLine("excelBook......." + ex.Message)
            End Try
            excelApp.Visible = False

            Dim m As Integer
            Dim sheetCount As Integer
            Try
                sheetCount = excelBook.Worksheets.Count
            Catch ex As Exception

            End Try

            If (sheetCount > 0) Then
                For m = 1 To sheetCount
                    Try
                        excelsheet = New Microsoft.Office.Interop.Excel.Worksheet()
                    Catch ex As Exception

                    End Try

                    Try
                        excelsheet = excelBook.Worksheets(m)
                        excelsheet.Select()
                    Catch ex As Exception
                        '    System.Console.WriteLine("excelsheet......" + ex.Message)
                    End Try

                    Dim row As Integer
                    Dim col As Integer
                    Try
                        row = excelsheet.UsedRange.Rows.Count()
                        col = excelsheet.UsedRange.Columns.Count()
                    Catch ex As Exception

                    End Try

                    Dim i As Integer
                    Dim j As Integer
                    For i = 1 To row
                        For j = 2 To 6   '1-6列的单元格
                            Dim cellvalue As String
                            Try
                                cellvalue = New String(excelApp.Cells(i, j).value.ToString())
                                If ((cellvalue.IndexOf("{") >= 0)) Then
                                    If ((cellvalue.IndexOf("}") >= 0)) Then
                                        Dim range As Microsoft.Office.Interop.Excel.Range
                                        suptable = New Hashtable
                                        subtable = New Hashtable
                                        setSupAndSub(cellvalue, excelApp, i, j)

                                        If (suptable.Keys.Count > 0) Then
                                            If (subtable.Keys.Count > 0) Then
                                                If (subtable.Keys.Count = suptable.Keys.Count) Then
                                                    range = excelApp.Cells(i, j)
                                                    range.Select()

                                                    Dim supkeys As IEnumerator
                                                    supkeys = suptable.Keys.GetEnumerator()

                                                    Dim subkeys As IEnumerator
                                                    subkeys = subtable.Keys.GetEnumerator()

                                                    Dim k As Integer
                                                    For k = 0 To suptable.Keys.Count
                                                        supkeys.MoveNext()
                                                        Dim beginIndex As Integer
                                                        Dim supValue As String

                                                        beginIndex = supkeys.Current
                                                        supValue = suptable.Item(beginIndex).ToString

                                                        With range.Characters(Start:=beginIndex + 1, Length:=supValue).Font
                                                            .Superscript = True
                                                            .Subscript = False
                                                        End With

                                                        subkeys.MoveNext()
                                                        Dim endIndex As Integer
                                                        Dim subValue As String

                                                        endIndex = subkeys.Current
                                                        subValue = subtable.Item(endIndex)

                                                        With range.Characters(Start:=endIndex + 1, Length:=subValue).Font
                                                            .Superscript = False
                                                            .Subscript = True
                                                        End With
                                                    Next

                                                End If

                                            End If

                                        End If

                                    End If

                                End If

                            Catch ex As Exception
                                '    System.Console.WriteLine("cell......" + ex.Message)
                            End Try

                        Next
                    Next
                Next
            End If
            '工作表保存：

            Try
                If Not excelApp.ActiveWorkbook.Saved Then
                    excelApp.SaveWorkspace()

                End If
                Dim xlSheet1 As Microsoft.Office.Interop.Excel.Worksheet
                xlSheet1 = excelBook.Worksheets(1)
                xlSheet1.Select()
                excelApp.Workbooks.Close()
            Catch ex As Exception

            End Try
        End If
    End Sub

 

'例如解析【叶片长度L{0,-0.05}】这种格式的值，0代表上标，-0.05代表下标。将来显示的结果是

    Private Sub setSupAndSub(ByVal cellvalue As String, ByVal excelApp As Microsoft.Office.Interop.Excel.Application, ByVal i As Integer, ByVal j As Integer)
        excelApp.DisplayAlerts = False
        If ((cellvalue.IndexOf("{") >= 0)) Then
            Dim beginIndex As Integer
            Dim endIndex As Integer
            Dim supAndsubInfo As String
            Dim supValue As String
            Dim subValue As String

            beginIndex = cellvalue.IndexOf("{")
            endIndex = cellvalue.IndexOf("}")
            supAndsubInfo = New String(cellvalue.Substring(cellvalue.IndexOf("{") + 1, endIndex - beginIndex - 1))

            If (supAndsubInfo.IndexOf(",") >= 0) Then
                supValue = supAndsubInfo.Substring(0, supAndsubInfo.IndexOf(","))
                subValue = supAndsubInfo.Substring(supAndsubInfo.IndexOf(",") + 1, supAndsubInfo.Length - supAndsubInfo.IndexOf(",") - 1)
                If (supValue.Length = 0) Then
                    supValue = 0
                End If
                If (subValue.Length = 0) Then
                    subValue = 0
                End If

                Dim info As String
                info = cellvalue.Substring(cellvalue.IndexOf("}") + 1)
                excelApp.Cells(i, j).Value = (cellvalue.Substring(0, cellvalue.IndexOf("{"))) + supValue + subValue + info

                Dim secondcellvalue As String
                secondcellvalue = (cellvalue.Substring(0, cellvalue.IndexOf("{"))) + supValue + subValue + info

                suptable.Add(beginIndex, supValue.Length)
                subtable.Add(beginIndex + supValue.Length, subValue.Length)

                If (secondcellvalue.IndexOf("{") >= 0) Then
                    If (secondcellvalue.IndexOf("}") >= 0) Then
                        setSupAndSub(secondcellvalue, excelApp, i, j)
                    End If
                End If
            End If
        End If
    End Sub

End Module