vba读取excel生成img

Sub generate()

Dim file As String
file = ThisWorkbook.Path & "\build1.img"
If Dir(file) <> "" Then Kill file
Open file For Binary As #1

'check sheet exist
Dim sheet As String
sheet = "#layout"
If checkSheetExist(sheet) = False Then
    MsgBox "error: " & "sheet: " & sheet & " no exist"
    End
End If

Dim tI As Integer
Dim tJModuleName As Integer
If FindSheetPos("#module_name", sheet, tI, tJModuleName) = False Then
    MsgBox "error: " & "sheet: " & "#module_name" & " no exist"
    End
End If

Dim tJoffset As Integer
If FindSheetPos("#offset", sheet, tI, tJoffset) = False Then
    MsgBox "error: " & "sheet: " & "#offset" & " no exist"
    End
End If

Dim tJSize As Integer
If FindSheetPos("#size", sheet, tI, tJSize) = False Then
    MsgBox "error: " & "sheet: " & "#size" & " no exist"
    End
End If

Dim tJGroupName As Integer
If FindSheetPos("#group_name", sheet, tI, tJGroupName) = False Then
    MsgBox "error: " & "sheet: " & "#group_name" & " no exist"
    End
End If

Dim pos As Integer
pos = 1
For i = tI + 1 To Sheets(sheet).UsedRange.Columns.Count Step 1
    Dim subSheet As String
    subSheet = Sheets(sheet).Cells(i, tJModuleName).Value
    If checkSheetExist(subSheet) = False Then
        If Len(subSheet) = 0 Then
            Exit For
        End If
        
        If PutStringToFile("0", Val(Sheets(sheet).Cells(i, tJSize).Value), pos) = False Then
            MsgBox "writeSheetData error: " & "file: " & file & " fail： " & subSheet & " " & subSheet
            End
        End If
    Else
        If writeSheetData(subSheet, pos) = False Then
        End If
    End If


    If Sheets(sheet).Cells(i, tJoffset).MergeArea.Address <> Sheets(sheet).Cells(i + 1, tJoffset).MergeArea.Address Then
        Debug.Print Sheets(sheet).Cells(i, tJGroupName).Value & " : " & Sheets(sheet).Cells(i + 1, tJGroupName).Value
        If StrComp(Sheets(sheet).Cells(i, tJGroupName).Value, "data_b", 1) <> 0 Then        'end in data_b
            If PutStringToFile("0", Val(Sheets(sheet).Cells(i + 1, tJoffset).Value) - pos + 1, pos) = False Then  '1: begin 1 not 0
                MsgBox "writeSheetData error: " & "file: " & file & " fail： " & subSheet & " " & subSheet
                End
            End If
        Else
            If PutStringToFile("0", 1024 - pos, pos) = False Then    '1024 is total size,not decreate 1 and file aways add 1
                MsgBox "writeSheetData error: " & "file: " & file & " fail： " & subSheet & " " & subSheet
                End
            End If
            Exit For
        End If
    End If
Next

Close #1
MsgBox "generate: " & file
End Sub

Function PutStringToFile(str As String, size As Integer, num As Integer) As Boolean
    Debug.Print "PutStringToFile: str: " & str & " size: " & size & " num: " & num
    str = Replace(str, ",", "") 'note: cell may exist ,
    
    Dim i As Integer
    Dim SubStr As String
    
    If StrComp(str, "0", 1) = 0 Then    '0 mean ascii 30
        Put #1, num, 0 '将内容写入文件
        num = num + 1
    Else
        For i = 1 To Len(str)
            SubStr = Mid(str, i, 1)
            Put #1, num, Asc(SubStr) '将内容写入文件
            num = num + 1
        Next
    End If
    
    For i = 1 To (size - Len(str))
        SubStr = Mid(str, i, 1)
        Put #1, num, 0 '将内容写入文件
        num = num + 1
    Next
    PutStringToFile = True
End Function

Function checkSheetExist(str As String) As Boolean
    For Each sh In Worksheets
        If sh.Name = str Then    '#layout
            checkSheetExist = True
            Exit Function
        End If
    Next sh
    checkSheetExist = False
End Function

Function writeSheetData(sheet As String, tpos As Integer) As Boolean
    Debug.Print "writeSheetData: sheet: " & sheet & " tpos: " & tpos
    
    Dim tISize As Integer
    Dim tJSize As Integer
    If FindSheetPos("Size", sheet, tISize, tJSize) = False Then
        MsgBox "error: " & "sheet: " & sheet & " Size" & " no exist"
        End
    End If

    Dim tJDefault As Integer
    If FindSheetPos("#default", sheet, tISize, tJDefault) = False Then
        MsgBox "error: " & "sheet: " & "#default" & " no exist"
        End
    End If
    
    For i = tISize + 1 To Sheets(sheet).UsedRange.Rows.Count Step 1
        Dim sheetStr As String
        sheetStr = Sheets(sheet).Cells(i, tJDefault).Value
        If PutStringToFile(sheetStr, Sheets(sheet).Cells(i, tJSize).Value, tpos) = False Then
            MsgBox "writeSheetData error: " & "file: " & file & " fail： " & sheet & " " & sheetStr
            End
        End If
    Next
    
    writeSheetData = True
End Function

Function FindSheetPos(str As String, sheet As String, t_i As Integer, t_j As Integer) As Boolean
    If checkSheetExist(sheet) = False Then
        FindSheetPos = False
        Exit Function
    End If
    
    For i = 1 To Sheets(sheet).UsedRange.Rows.Count Step 1
        For j = 1 To Sheets(sheet).UsedRange.Columns.Count Step 1
            If Sheets(sheet).Cells(i, j).Value = str Then
                t_i = i
                t_j = j
                FindSheetPos = True
                Exit Function
            End If
        Next
    Next
    
    FindSheetPos = False
End Function