不调用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 Type

Dim fhFile As Integer

Dim bof1 As BOF

Dim eof1 As EOF

Dim l1 As tLabel

Dim i1 As tInteger

Dim n1 As tNumber

Private 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 With

End Sub

Public Sub OpenFile(ByVal FileName As String)

fhFile = FreeFile

Open FileName For Binary As #fhFile

Put #fhFile, , bof1

End Sub

Public Sub CloseFile()

Put #fhFile, , eof1

Close #fhFile

End Sub

Function 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

Next

End Function

Function 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 Function

Function 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