现在的位置: 首页 > 综合 > 正文

到底怎样才能把下面的Matlab代码变成VBA形式啊

2013年10月01日 ⁄ 综合 ⁄ 共 8273字 ⁄ 字号 评论关闭

function [data, xAxis, misc] = spload(filename)
% 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
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;

fid = fopen(filename,'r');
if fid == -1
    error('Cannot open the file.');
    return
end

% Fixed file header of signature and description
signature = setstr(fread(fid, 4, 'uchar')');
if ~strcmp(signature, 'PEPE')
   
    error('This is not a PerkinElmer block structured file.');
    return
end
description = setstr(fread(fid, 40, 'uchar')');

% Initialize a variable so we can tell if we have read it.
xLen = int32(0);

% The rest of the file is a list of blocks
while ~feof(fid)
    blockID = fread(fid,1,'int16');
    blockSize = fread(fid,1,'int32');
   
    % feof does not go true until after the read has failed.
    if feof(fid)
        break
    end
   
    switch blockID
        case DSet2DC1DIBlock
        % Wrapper block.  Read nothing.

        case DataSetAbscissaRangeMember
            innerCode = fread(fid, 1, 'int16');
            %_ASSERTE(CvCoOrdRangeType == nInnerCode);
            x0 = fread(fid, 1, 'double');
            xEnd = fread(fid, 1, 'double');
               
        case DataSetIntervalMember
            innerCode = fread(fid, 1, 'int16');
            xDelta = fread(fid, 1, 'double');

        case DataSetNumPointsMember
            innerCode = fread(fid, 1, 'int16');
            xLen = fread(fid, 1, 'int32');

        case DataSetXAxisLabelMember
            innerCode = fread(fid, 1, 'int16');
            len = fread(fid, 1, 'int16');
            xLabel = setstr(fread(fid, len, 'uchar')');

        case DataSetYAxisLabelMember
            innerCode = fread(fid, 1, 'int16');
            len = fread(fid, 1, 'int16');
            yLabel = setstr(fread(fid, len, 'uchar')');
           
        case DataSetAliasMember
            innerCode = fread(fid, 1, 'int16');
            len = fread(fid, 1, 'int16');
            alias = setstr(fread(fid, len, 'uchar')');
         
        case DataSetNameMember
            innerCode = fread(fid, 1, 'int16');
            len = fread(fid, 1, 'int16');
            originalName = setstr(fread(fid, len, 'uchar')');
         
        case DataSetDataMember
            innerCode = fread(fid, 1, 'int16');
            len = fread(fid, 1, 'int32');
            % innerCode should be CvCoOrdArrayType
            % len should be xLen * 8
            if xLen == 0
                xLen = len / 8;
            end
            data = fread(fid, xLen, 'double');
 
        otherwise               % unknown block, just seek past it
            fseek(fid, blockSize, 'cof');
    end
end
fclose(fid);

if xLen == 0
    error('The file does not contain spectral data.');
    return
end

% Expand the axes specifications into vectors
xAxis = 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};

 

 

下面的代码好像不行啊

http://www.visualbasic.happycodings.com/Files_Directories_Drives/code52.html

Reading and writing binary data from files

The following routines demonstrate how to write/read data to/from a file. The data can be an array or any simple data type.

Option Explicit

'Purpose     :  Saves/writes a block of data to a file
'Inputs      :  vData                   The data to store in the file. Can be an
'                                       array or any simple data type.
'               sFileName               The path and file name where the data is to be stored
'               [bAppendToFile]         If True will append the data to the existing file
'Outputs     :  Returns True if succeeded in saving data
'Notes       :  Saves data type (text and binary).

Function FileWriteBinary(vData As Variant, sFileName As String, Optional bAppendToFile As Boolean = True) As Boolean
    Dim iFileNum As Integer, lWritePos As Long
   
    On Error GoTo ErrFailed
    If bAppendToFile = False Then
        If Len(Dir$(sFileName)) > 0 And Len(sFileName) > 0 Then
            'Delete the existing file
            VBA.Kill sFileName
        End If
    End If
   
    iFileNum = FreeFile
    Open sFileName For Binary Access Write As #iFileNum
   
    If bAppendToFile = False Then
        'Write to first byte
        lWritePos = 1
    Else
        'Write to last byte + 1
        lWritePos = LOF(iFileNum) + 1
    End If
   
    Put #iFileNum, lWritePos, vData
    Close iFileNum
   
    FileWriteBinary = True
    Exit Function

ErrFailed:
    FileWriteBinary = False
    Close iFileNum
    Debug.Print Err.Description
End Function

'Purpose     :  Reads the contents of a binary file
'Inputs      :  sFileName               The path and file name where the data is stored
'Outputs     :  Returns an array containing all the data stored in the file.
'               e.g. ArrayResults(1 to lNumDataBlocks)
'               Where lNumDataBlocks is the number of data blocks stored in file.
'               If the file was created using FileWriteBinary, this will be the number
'               of times data was appended to the file.

Function FileReadBinary(sFileName As String) As Variant
    Dim iFileNum As Integer, lFileLen As Long
    Dim vThisBlock As Variant, lThisBlock As Long, vFileData As Variant
   
    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)
       
        Do
            lThisBlock = lThisBlock + 1
            Get #iFileNum, , vThisBlock
            If IsEmpty(vThisBlock) = False Then
                If lThisBlock = 1 Then
                    ReDim vFileData(1 To 1)
                Else
                    ReDim Preserve vFileData(1 To lThisBlock)
                End If
                vFileData(lThisBlock) = vThisBlock
            End If
        Loop While EOF(iFileNum) = False
        Close iFileNum
       
        FileReadBinary = vFileData
    End If

    Exit Function
   
ErrFailed:
    Close iFileNum
    Debug.Print Err.Description
End Function

'Demonstration routine
Sub Test()
    Dim avValues() As Long, lThisRow As Long
    Dim avFileData As Variant, vThisBlock As Variant, vThisSubBlock As Variant
    Dim lThisBlock As Long
   
    'Create an array of numbers
    ReDim avValues(1 To 10)
    For lThisRow = 1 To 10
        avValues(lThisRow) = lThisRow
    Next
    'Write the array to a file
    If FileWriteBinary(avValues, "C:/Test.dat") Then
        'Read the data back from the file
        avFileData = FileReadBinary("C:/Test.dat")
        If IsArray(avFileData) Then
            'Print data
            Debug.Print "Values returned:"
            For Each vThisBlock In avFileData
                lThisBlock = lThisBlock + 1
                Debug.Print "Data Set:" & CStr(lThisBlock)
                For Each vThisSubBlock In vThisBlock
                    Debug.Print vThisSubBlock
                Next
            Next
            'Completed
            MsgBox "The array has been successfully retrieved!", vbInformation
        End If
    End If
End Sub

抱歉!评论已关闭.