Exceptionを見やすく

Sub FormatException_Click()
   Dim ash As Worksheet
   Set ash = ActiveSheet
   Dim sh As Worksheet
   Set sh = ActiveWorkbook.Sheets.Add
   sh.Name = Format(Now, "YYYYMMDD_HHmmSS")
   sh.Move , ActiveWorkbook.Sheets.Item(ActiveWorkbook.Sheets.Count)
   
   Dim strException As String
   strException = ash.cells(3, 2).Value
   Dim aryException As Variant
   aryException = Split(strException, "at ")
   
   sh.cells(7, 1).Value = "クラス"
   sh.cells(7, 2).Value = "メソッド"
   sh.cells(7, 3).Value = "行番号"
   
   
   Dim i As Integer
   For i = 0 To UBound(aryException)
       If i = 0 Then
           Dim aryMessage As Variant
           aryMessage = Split(aryException(i), ":")
           On Error Resume Next
           sh.cells(i + 1, 1).Value = aryMessage(0)
           sh.cells(i + 2, 1).Value = aryMessage(1)
           sh.cells(i + 3, 1).Value = aryMessage(2)
           sh.cells(i + 4, 1).Value = aryMessage(3)
           On Error GoTo 0
       Else
           Dim aryClass As Variant
           On Error Resume Next
           aryClass = Split(aryException(i), "(")
           sh.cells(i + 7, 1).Value = aryClass(0)
           
           
           Dim aryMethod As Variant
           aryMethod = Split(Replace(aryClass(1), ")", ""), ":")
           sh.cells(i + 7, 2).Value = aryMethod(0)
           sh.cells(i + 7, 3).Value = aryMethod(1)
           On Error GoTo 0
           
       End If
   Next
   
   movewidh
   setColor sh, "^org\.ajax4jsf", 9
   setColor sh, "^com\.sun", 53
   setColor sh, "^weblogic\.servlet", 12
   setColor sh, "^javax\.faces", 14
   setColor sh, "^org\.springframework", 14
   
End Sub

Sub movewidh()
   Columns("A:A").ColumnWidth = 18.5
   Columns("A:A").ColumnWidth = 35.5
   Columns("A:A").ColumnWidth = 44.38
   Columns("A:A").ColumnWidth = 55.38
   Columns("A:A").ColumnWidth = 51.5
   Columns("B:B").ColumnWidth = 23.25
   Columns("B:B").ColumnWidth = 21.38
   Columns("C:C").ColumnWidth = 6.5
End Sub

Sub setColor(sh As Worksheet, strPattern, intColorIndex)
   Dim i As Integer
   
   Dim reg As RegExp
   Set reg = New RegExp
   reg.Pattern = strPattern
   
   For i = 7 To 1000
       If reg.Test(sh.cells(i, 1).Value) Then
           sh.cells(i, 1).Interior.ColorIndex = intColorIndex
       End If
   Next
End Sub

Last-modified: 2010-09-03 (金) 10:44:01 (4976d)