帮助 | 注册 | 登录

不调用EXCEL对象库生成其文件的类(VB)
来源:全民业务网 作者:不详

    不调用EXCEL对象库生成其文件的类(VB)
    不调用EXCEL对象库生成其文件的类(VB)    Option Explicit
Private Type BOF
    opcode As Integer
    length As Integer
    version As Integer
    ftype As Integer
End Type'End Of File record
Private Type EOF
    opcode As Integer
    length As Integer
End Type'Integer record
Private Type tInteger
    opcode As Integer
    length As Integer
    Row As Integer
    Col As Integer
    rgbAttr1 As Byte
    rgbAttr2 As Byte
    rgbAttr3 As Byte
    Value As Integer
End Type'Number = double record
Private Type tNumber
    opcode As Integer
    length As Integer
    Row As Integer
    Col As Integer
    rgbAttr1 As Byte
    rgbAttr2 As Byte
    rgbAttr3 As Byte
    Value As Double
End Type'Label (Text) record
Private Type tLabel
    opcode As Integer
    length As Integer
    Row As Integer
    Col As Integer
    rgbAttr1 As Byte
    rgbAttr2 As Byte
    rgbAttr3 As Byte
    strLength As Byte
End TypeDim fhFile As Integer
Dim bof1 As BOF
Dim eof1 As EOF
Dim l1 As tLabel
Dim i1 As tInteger
Dim n1 As tNumberPrivate Sub Class_Initialize()
    'Set up default values for records
    'These should be the values that are the same for every record    With bof1
        .opcode = 9
        .length = 4
        .version = 2
        .ftype = 10
    End With    With eof1
        .opcode = 10
    End With    With l1
        .opcode = 4
        .length = 10
        .Row = 0
        .Col = 0
        .rgbAttr1 = 0
        .rgbAttr2 = 0
        .rgbAttr3 = 0
        .strLength = 2
    End With    With i1
        .opcode = 2
        .length = 9
        .Row = 0
        .Col = 0
        .rgbAttr1 = 0
        .rgbAttr2 = 0
        .rgbAttr3 = 0
        .Value = 0
    End With    With n1
        .opcode = 3
        .length = 15
        .Row = 0
        .Col = 0
        .rgbAttr1 = 0
        .rgbAttr2 = 0
        .rgbAttr3 = 0
        .Value = 0
    End WithEnd SubPublic Sub OpenFile(ByVal FileName As String)
    fhFile = FreeFile
    Open FileName For Binary As #fhFile
    Put #fhFile, , bof1
End SubPublic Sub CloseFile()
    Put #fhFile, , eof1
    Close #fhFile
End SubFunction EWriteString(ExcelRow As Integer, ExcelCol As Integer, Text As String)
    Dim b As Byte, l As Byte, a As Byte
    'Length of the text portion of the record
    l = Len(Text)
    l1.strLength = l    'Total length of the record
    l1.length = 8 + l1.strLength    l1.Row = ExcelRow - 1
    l1.Col = ExcelCol - 1    'Put record header
    Put #fhFile, , l1    'Then the actual string data
    'We have to write the string one character at a time, so we loop
    'through all characters in the string, assign thier ASCII value to b
    'and do a Put on b (which is declared as Byte)
    For a = 1 To l
        b = Asc(Mid$(Text, a, 1))
        Put #fhFile, , b
    NextEnd FunctionFunction EWriteInteger(ExcelRow As Integer, ExcelCol As Integer, Value As Integer)
    With i1
        .Row = ExcelRow - 1
        .Col = ExcelCol - 1
        .Value = Value
    End With    Put #fhFile, , i1
End FunctionFunction EWriteDouble(ExcelRow As Integer, ExcelCol As Integer, Value As Double)
    With n1
        .Row = ExcelRow - 1
        .Col = ExcelCol - 1
        .Value = Value
    End With    Put #fhFile, , n1
End Function


  

  • 上一篇:在EXCEL中获取列中不重复的值的个数
  • 下一篇:利用GDI+函数构造图形报表