调试VBA代码, 很难搞定啊

Option Explicit

'Demonstration routine
Sub spload()
'[data, xAxis, misc] =
' Reads in spectra from PerkinElmer block structured files.
' This version supports 'Spectrum' SP files.
' Note that earlier 'Data Manager' formats are not supported.
'
' [data, xAxis, misc] = spload(filename):
'   data:  1D array of doubles
'   xAxis: vector for abscissa (e.g. Wavenumbers).
'   misc: miscellanous information in name,value pairs

' Copyright (C)2007 PerkinElmer Life and Analytical Sciences
' Stephen Westlake, Seer Green
'
' History
' 2007-04-24 SW     Initial version

' Block IDs
Dim sFilename As String

Dim iFileNum As Integer, lFileLen As Long
Dim vThisBlock As Variant, lThisBlock As Long, vFileData As Variant

' convert variable types between VBA get and Matlab fread
Dim uchar As Byte
Dim unchar(0 To 43) As String

Dim int16 As Integer
Dim int32 As Long
Dim double_ As Double
Dim wavenumber(0 To 3550) As Double
Dim absorbance(0 To 3550) As Double
Dim WavenumberIndex As Integer
Dim AbsorbanceIndex As Integer

Dim DSet2DC1DIBlock As Integer
Dim HistoryRecordBlock  As Integer
Dim InstrHdrHistoryRecordBlock  As Integer
Dim InstrumentHeaderBlock   As Integer
Dim IRInstrumentHeaderBlock As Integer
Dim UVInstrumentHeaderBlock As Integer
Dim FLInstrumentHeaderBlock As Integer
       
Dim DataSetDataTypeMember   As Integer
Dim DataSetAbscissaRangeMember  As Integer
Dim DataSetOrdinateRangeMember  As Integer
Dim DataSetIntervalMember   As Integer
Dim DataSetNumPointsMember  As Integer
Dim DataSetSamplingMethodMember As Integer
Dim DataSetXAxisLabelMember As Integer
Dim DataSetYAxisLabelMember As Integer
Dim DataSetXAxisUnitTypeMember  As Integer
Dim DataSetYAxisUnitTypeMember  As Integer
Dim DataSetFileTypeMember   As Integer
Dim DataSetDataMember   As Integer
Dim DataSetNameMember   As Integer
Dim DataSetChecksumMember   As Integer
Dim DataSetHistoryRecordMember  As Integer
Dim DataSetInvalidRegionMember  As Integer
Dim DataSetAliasMember  As Integer
Dim DataSetVXIRAccyHdrMember    As Integer
Dim DataSetVXIRQualHdrMember    As Integer
Dim DataSetEventMarkersMember   As Integer
       
Dim ShortType   As Integer
Dim UShortType  As Integer
Dim IntType As Integer
Dim UIntType    As Integer
Dim LongType    As Integer
Dim BoolType    As Integer
Dim CharType    As Integer
Dim CvCoOrdPointType    As Integer
Dim StdFontType As Integer
Dim CvCoOrdDimensionType    As Integer
Dim CvCoOrdRectangleType    As Integer
Dim RGBColorType    As Integer
Dim CvCoOrdRangeType    As Integer
Dim DoubleType  As Integer
Dim CvCoOrdType As Integer
Dim ULongType   As Integer
Dim PeakType    As Integer
Dim CoOrdType   As Integer
Dim RangeType   As Integer
Dim CvCoOrdArrayType    As Integer
Dim EnumType    As Integer
Dim LogFontType As Integer

DSet2DC1DIBlock = 120
HistoryRecordBlock = 121
InstrHdrHistoryRecordBlock = 122
InstrumentHeaderBlock = 123
IRInstrumentHeaderBlock = 124
UVInstrumentHeaderBlock = 125
FLInstrumentHeaderBlock = 126
' Data member IDs
DataSetDataTypeMember = -29839
DataSetAbscissaRangeMember = -29838
DataSetOrdinateRangeMember = -29837
DataSetIntervalMember = -29836
DataSetNumPointsMember = -29835
DataSetSamplingMethodMember = -29834
DataSetXAxisLabelMember = -29833
DataSetYAxisLabelMember = -29832
DataSetXAxisUnitTypeMember = -29831
DataSetYAxisUnitTypeMember = -29830
DataSetFileTypeMember = -29829
DataSetDataMember = -29828
DataSetNameMember = -29827
DataSetChecksumMember = -29826
DataSetHistoryRecordMember = -29825
DataSetInvalidRegionMember = -29824
DataSetAliasMember = -29823
DataSetVXIRAccyHdrMember = -29822
DataSetVXIRQualHdrMember = -29821
DataSetEventMarkersMember = -29820
'Type code IDs
ShortType = 29999
UShortType = 29998
IntType = 29997
UIntType = 29996
LongType = 29995
BoolType = 29988
CharType = 29987
CvCoOrdPointType = 29986
StdFontType = 29985
CvCoOrdDimensionType = 29984
CvCoOrdRectangleType = 29983
RGBColorType = 29982
CvCoOrdRangeType = 29981
DoubleType = 29980
CvCoOrdType = 29979
ULongType = 29978
PeakType = 29977
CoOrdType = 29976
RangeType = 29975
CvCoOrdArrayType = 29974
EnumType = 29973
LogFontType = 29972

Dim innerCode As Integer
Dim x0 As Double
Dim xEnd As Double
Dim xDelta As Double
Dim xLen As Long
Dim xLabel() As String 'Byte
Dim length As Integer
Dim yLabel() As String 'Byte
Dim alias() As String 'Byte
Dim OriginalName() As String 'Byte
Dim data() As Double
'Dim xLength As Integer
Dim offset() As Byte

Dim ucharIndex As Integer
Dim uncharIndex As Integer
Dim description As String
Dim i, j, k, m, n, p As Integer
Dim BlockID As Integer
Dim BlockSize As Long
Dim position As Long
position = 1

sFilename = "D:/CalibratedSpectra/5.22.sp"
Debug.Print sFilename
   
    On Error GoTo ErrFailed
   
    If Len(Dir$(sFilename)) > 0 And Len(sFilename) > 0 Then
        iFileNum = FreeFile
        Open sFilename For Binary Access Read As #iFileNum
       
        'lFileLen = LOF(iFileNum)
        WavenumberIndex = 0
        AbsorbanceIndex = 0
       
        For ucharIndex = 0 To 43
         Get #iFileNum, , uchar
                  position = position + 1
                  Debug.Print "Current Pointer:" & position
         unchar(ucharIndex) = uchar
        
        Next ucharIndex
       
        ' determine the fomart
            If Chr(unchar(0)) & Chr(unchar(1)) & Chr(unchar(2)) & Chr(unchar(3)) <> "PEPE" Then
           
            MsgBox "The file " & sFilename & " is not desired Perkin Elmer *.sp binary spectral file."
            Exit Sub
           
            End If

Debug.Print "The first 4 characters are: " & Chr(unchar(0)) & Chr(unchar(1)) & Chr(unchar(2)) & Chr(unchar(3))

description = ""
For ucharIndex = 4 To 43
description = description & Chr(unchar(ucharIndex))
Next ucharIndex

Debug.Print "The description of the file is: " & description

'xLen = int32(0)
       
        Do
'            lThisBlock = lThisBlock + 1
        Get #iFileNum, , int16
        position = position + 2
        Debug.Print "Current Pointer:" & position
        BlockID = int16
        Debug.Print "BlockID is: " & BlockID
       
        Get #iFileNum, , int32
        position = position + 4
        BlockSize = int32
        Debug.Print "Current Pointer:" & position
        Debug.Print "Block size is: " & BlockSize
       
           Select Case BlockID
                            Case DSet2DC1DIBlock
                            '% Wrapper block.  Read nothing.
                               Debug.Print " Case DSet2DC1DIBlock; Read Nothing"
                            Case DataSetAbscissaRangeMember
                                Get #iFileNum, , innerCode
                                position = position + 2
                                Debug.Print "Current Pointer:" & position
                                '%_ASSERTE(CvCoOrdRangeType == nInnerCode)
                                Get #iFileNum, , x0
                                position = position + 8
                                Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , xEnd
                                position = position + 8
                                Debug.Print "Current Pointer:" & position
                                Debug.Print " Case DataSetAbscissaRangeMember"
                                Debug.Print "innerCode is: " & innerCode
                                Debug.Print "x0 is: " & x0
                                Debug.Print "xEnd is: " & xEnd
                                   
                            Case DataSetIntervalMember
                                Get #iFileNum, , innerCode
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , xDelta
                                   position = position + 8
                                   Debug.Print "Current Pointer:" & position
                                Debug.Print " Case DataSetIntervalMember"
                                Debug.Print "innerCode is: " & innerCode
                                Debug.Print "xDelta is: " & xDelta
                                                               
                   
                            Case DataSetNumPointsMember
                                Get #iFileNum, , innerCode
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , xLen
                                    position = position + 4
                                    Debug.Print "Current Pointer:" & position
                                Debug.Print " Case DataSetNumPointsMember"
                                Debug.Print "innerCode is: " & innerCode
                                Debug.Print "xDelta is: " & xLen
                                                               
                            Case DataSetXAxisLabelMember
                                Get #iFileNum, , innerCode
                                    position = position + 2
                                    Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , length
                                      position = position + 2
                                      Debug.Print "Current Pointer:" & position
                                Debug.Print " Case DataSetXAxisLabelMember"
                                For i = 0 To length - 1
                                  Get #iFileNum, , xLabel(i)
                                  position = position + 1
                                  Debug.Print "Current Pointer:" & position
                                 Debug.Print "xlabel(" & i & ") is" & xLabel(i)
                                Next i
                               
                               
                            Case DataSetYAxisLabelMember
                             Debug.Print " Case DataSetYAxisLabelMember"
                                Get #iFileNum, , innerCode
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , length
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                For j = 0 To length - 1
                                 Get #iFileNum, , yLabel(j)
                                   position = position + 1
                                   Debug.Print "Current Pointer:" & position
                                Next j
                            Case DataSetAliasMember
                             Debug.Print " Case DataSetAliasMember"
                                Get #iFileNum, , innerCode
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , length
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                For k = 0 To length - 1
                                Get #iFileNum, , alias(k)
                                  position = position + 1
                                  Debug.Print "Current Pointer:" & position
                                Next k
                            Case DataSetNameMember
                             Debug.Print " Case DataSetNameMember"
                                Get #iFileNum, , innerCode
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , length
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                For m = 0 To length - 1
                                  Get #iFileNum, , OriginalName(m)
                                    position = position + 1
                                Next m
                            Case DataSetDataMember
                            Debug.Print " Case DataSetDataMember"
                                Get #iFileNum, , innerCode
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                Get #iFileNum, , length
                                  position = position + 2
                                  Debug.Print "Current Pointer:" & position
                                '% innerCode should be CvCoOrdArrayType
                                '% length should be xLen * 8
                                If xLen = 0 Then
                                    xLen = length / 8
                                End If
                                For n = 0 To xLen - 1
                                 Get #iFileNum, , data(n)
                                   position = position + 8
                                   Debug.Print "Current Pointer:" & position
                                Next n
                            Case Else
                            Debug.Print " Case Else"
                                'For p = 0 To BlockSize - 1
                                'Get #iFileNum, , offset
                                 ' position = position + 1
                               ' Next p
                               Debug.Print "Current Pointer:" & position
                               Debug.Print "position + BlockSize is: " & (position + BlockSize)
                               Seek #iFileNum, position + BlockSize
            End Select
                    
           
        Loop While EOF(iFileNum) = False
        Close iFileNum
       
    Else
        Exit Sub
   
    End If

  
If xLen = 0 Then
   MsgBox "The file does not contain spectral data."
    Exit Sub
End If

' Expand the axes specifications into vectors
'wavenumber= x0: xDelta: xEnd

' Return the other details as name,value pairs
'misc(1,:) = {'xLabel', xLabel}
'misc(2,:) = {'yLabel', yLabel}
'misc(3,:) = {'alias', alias}
'misc(4,:) = {'original name', originalName}

ErrFailed:
    Close iFileNum
    Debug.Print Err.description

End Sub