Public Function GetHeight(page As Integer) As Single

    On Error GoTo err_proc
    
    GetHeight = dicPageHeight.item(page)
    
    Exit Function
    
'*錯誤處理
err_proc:
    GetHeight = 0
    
End Function

'**************************************************************
'*名稱：GetCutPage
'*功能：得到分頁信息
'*傳入參數：
'*      uWidth          --可用頁寬度
'*作者：progame
'*日期：2002-03-27 16:39:08
'***************************************************************
Private Sub GetCutPage(uWidth As Single)
Dim i               As Integer
Dim sWidth          As Single
Dim cp              As Integer

    cp = 1
    sWidth = 0
    For i = 1 To m_cols
    
        sWidth = sWidth + colText(i).width
        
        If sWidth > uWidth And i <> 1 Then
            cp = cp + 1
            sWidth = colText(i).width
        End If
        
        colText(i).tag = cp
        colText(i).Left = sWidth - colText(i).width
        
    Next i

    
End Sub

'**************************************************************
'*名稱：Merge
'*功能：合并單元格
'*傳入參數：
'*      pageWidth       --可用的頁寬度
'*      pageHeight      --可用的面高度
'*      firstPageHeight --第一頁的可用高度
'*      latPageHeight   --最后一頁的可用高度
'*返回參數：
'*
'*作者：progame
'*日期：2002-04-20 22:25:25
'***************************************************************
Public Sub Merge(pagewidth As Single, _
                 pageheight As Single, _
                 firstPageHeight As Single, _
                 lastPageHeight As Single)
'*合并單元格
Dim page            As Integer
Dim row             As Integer
Dim bRowLeft        As Boolean          '*是否有行剩下
Dim i               As Integer

    '*首先重新得到分頁信息
    GetCutPage pagewidth
    
    ReDim dicCurPage(1 To m_cols)
    
    For i = 1 To m_cols
        Set dicCurPage(i) = New Dictionary
        colHeight(i) = 0
    Next i
    
    Set dicMergeCell = Nothing
    Set dicPageHeight = Nothing
    Set dicMergeCell = New Dictionary
    Set dicPageHeight = New Dictionary
    
    page = 0
    
    For row = 1 To m_rows
        bRowLeft = True
        '*在當前頁的所有單元格中加入此行
        AddRow row
        
        '*判斷是否超出高度(如果超出，存儲已經確定的單元格，并清空當前頁，新開頁）
        If OutHeight(page, row, pageheight, firstPageHeight, lastPageHeight) Then
        
            If row <> 1 Then        '*如果是第一行，不移除
                RemoveRow row
            End If
            
            '*保存當前頁的單元格，并清空當前頁
            page = page + 1
            SavePage page
            bRowLeft = False
            
            '*再次增加此行
            AddRow row

        End If
        
        'DoEvents
        RaiseEvent InitProgress(row / m_rows * 100)
        
    Next row
    
    '*最后如果有多出來的行，增加頁
    If bRowLeft Then
        page = page + 1
        SavePage page
    End If
    
    
    '*將合并后的單元格充入到二維數組
    FillCell
    
    '*釋放對象
    Set dicMergeCell = Nothing
    
    '*釋放數組
    Erase dicCurPage
    
End Sub

Private Sub AddRow(row As Integer)
'*在當前頁的集合中添加一行row

Dim cell            As clsCellNew
Dim mergeCell       As clsCellNew
Dim col             As Integer
Dim cText           As clsText

    For col = 1 To m_cols
        lstColHeight(col) = colHeight(col)
        Set cell = cells(col, row)
        
        If IfMerge(col, row) Then       '*是否需要合并
            dicCurPage(col).item(dicCurPage(col).Count).rowTo = dicCurPage(col).item(dicCurPage(col).Count).rowTo + 1
        Else                            '*如果不要合并
            '*添加一個新的單元格
            Set mergeCell = New clsCellNew
            
            With mergeCell
                .colFrom = col
                .rowFrom = row
                .rowTo = row
                .stringX = cell.stringX
                .Top = lstColHeight(col)
                colText(col).stringX = .stringX
                .height = colText(col).GetRows * colText(col).rowheight
            End With
            
            '*增加了一個單元格，colheight增加
            colHeight(col) = colHeight(col) + mergeCell.height
            
            dicCurPage(col).Add dicCurPage(col).Count + 1, mergeCell
            
            Set mergeCell = Nothing
            
        End If
    Next col
    
    '*計算新的高度
    Dim maxHeight   As Single
    
    For col = 1 To m_cols
    
        If colHeight(col) > maxHeight Then
            maxHeight = colHeight(col)
        End If
        
    Next col
    
    '*重新設定最后一個單元格的高度差(為maxHeight - colHeight(col))
    For col = 1 To m_cols
    
        dicCurPage(col).item(dicCurPage(col).Count).height = _
            dicCurPage(col).item(dicCurPage(col).Count).height _
            + (maxHeight - colHeight(col))

        '*將colheight統一到maxHeight
        colHeight(col) = maxHeight
        
    Next col
End Sub

Private Sub RemoveRow(row As Integer)
'*移除一行
Dim col         As Integer
    
    For col = 1 To m_cols
    
        If IfMerge(col, row) Then
            '*將最后一個單元格重新設定高度
            dicCurPage(col).item(dicCurPage(col).Count).height = _
                dicCurPage(col).item(dicCurPage(col).Count).height _
                - (colHeight(col) - lstColHeight(col))
        Else
            '*移除當前頁的最后一個單元格
            dicCurPage(col).Remove dicCurPage(col).Count
        End If
        
        colHeight(col) = lstColHeight(col)
        
    Next col
    

End Sub

Private Sub SavePage(page As Integer)
'*存儲當前頁，并清空

Dim col         As Integer
Dim cell
       
    '*保存當前頁的正文高度
    dicPageHeight.Add page, colHeight(m_cols)
    
    For col = 1 To m_cols
    
        For Each cell In dicCurPage(col).Items
        
            With cell
                .page = page
            End With
            
            dicMergeCell.Add dicMergeCell.Count + 1, cell
            
        Next
        
        dicCurPage(col).RemoveAll
        lstColHeight(col) = 0
        colHeight(col) = 0
        
    Next col
    
End Sub

Private Function IfMerge(col As Integer, row As Integer) As Boolean
'*是否需要合并

    '*如果此列不需要合并，直接返回
    If Not mergeCol(col) Then
        IfMerge = False
        Exit Function
    End If
    
    '*如果當前頁的此列沒有單元格，說明是第一個單元格，所以不要合并
    If dicCurPage(col).Count = 0 Then
        IfMerge = False
        Exit Function
    End If
    
    '*如果和上一個單元格的內容不同，則不需要合并
    If cells(col, row - 1).stringX _
        <> cells(col, row).stringX Then
        IfMerge = False
    Else
        IfMerge = True
    End If
    
End Function

Private Sub FillCell()
'*將合并后的單元格充入到二維數組

Dim cell

    '*重新定義數組
    Dim pages       As Integer
    Dim cutpages    As Integer
    
    Set cell = dicMergeCell.item(dicMergeCell.Count)
    pages = cell.page
    cutpages = colText(m_cols).tag
    
    ReDim dicCell(1 To pages, 1 To cutpages)
    
    Dim i As Integer, j As Integer
    
    For i = 1 To pages
    
        For j = 1 To cutpages
            Set dicCell(i, j) = New Dictionary
        Next j
        
    Next i
    
    '*填充
    For Each cell In dicMergeCell.Items
        page = cell.page
        cutpage = colText(cell.colFrom).tag
        
        dicCell(page, cutpage).Add dicCell(page, cutpage).Count + 1, cell
    Next
    
End Sub

Private Function OutHeight(page As Integer, row As Integer, _
                           ByRef pageheight As Single, _
                           ByRef firstPageHeight As Single, _
                           ByRef lastPageHeight As Single) As Boolean
'*是否超出了頁寬
Dim mPageHeight     As Single

    If page + 1 = 1 Then
        mPageHeight = firstPageHeight
    Else
        mPageHeight = pageheight
    End If

    If colHeight(m_cols) > mPageHeight Then
        OutHeight = True
        Exit Function
    End If

    '*如果是最后一條記錄
    If row = m_rows Then
        If colHeight(m_cols) > mPageHeight - (lastPageHeight - pageheight) Then
            OutHeight = True
            Exit Function
        End If
    End If
    
    OutHeight = False
End Function

Private Sub Class_Terminate()
'*釋放對象
    Set dicMergeCell = Nothing
    Set dicPageHeight = Nothing
    
'*釋放數組
    Erase dicCurPage
    Erase cells
    Erase colHeight
    Erase lstColHeight
    Erase dicCell
End Sub