Attribute VB_Name = "工作表10"
'**************** 程式變數 ******************
Const PYEAR = 2023
Const PCOMPANY = 27
Const strXLSfile = "\index.xlsb" '資料來源
Const intFieldAmount = 20                           '表中欄位數目
Const ITEMcount = 9                                '處理品項數目
Const MSC = 5                                       '男生班級行數
Const MSD = 7                                       '男生小計行數
Const WSC = 13                                      '女生班級行數
Const WSD = 15                                      '女生小計行數
'********************************************

Private Sub Worksheet_Activate()
Dim p As Long
Dim diag As New ProgressDialogue
Application.Calculation = xlManual      '設置手動重算
p = 0
diag.Configure "更新資料時間", "Now wasting your time...", 0, ITEMcount
diag.Show
    For i = 1 To ITEMcount
        Call subtotal(i, 1, 3)
        Call subtotal(i, 2, 3)
diag.SetValue p
diag.SetStatus "Now wasting your time... " & p
p = p + 1
    Next i
diag.Hide
Application.Calculation = xlAutomatic   '設置自動重算

End Sub

Public Sub subtotal(strField As Variant, intRange As Variant, intRow As Variant)
' strField      小計使用欄位
' intRange  男、女      1,2
' intRow        填入列數
Dim rstSubtotal As ADODB.Recordset
Dim strSQL As String
Dim intRowLoc As Integer
Dim fldClass, fldAmount As Field
Dim cellClass, cellData As Range

Dim Cnmy As ADODB.Connection
Set Cnmy = Cnmyopen()
Set rstSubtotal = New ADODB.Recordset
    strSQL = "SELECT departclass, sum(item" & strField & ") " & _
                    "FROM clothing.BUYANDSELL " & _
                    "where departclass<>'0' and " & Choose(intRange, "cus_sex=true and ", "cus_sex=false and ", "") & _
                    "sid between " & PYEAR & PCOMPANY & "0000 AND " & PYEAR & PCOMPANY & "9999" & _
                    " group by department;"
'    Debug.Print strSQL
'    rstSubtotal.CursorLocation = 3         'mysql RecordCount連線BUG by 藍色小舖 老頑童
    rstSubtotal.Open strSQL, Cnmy

Set fldClass = rstSubtotal.Fields(0)                                                                            '項目尺寸
Set fldAmount = rstSubtotal.Fields(1)                                                                           '項目尺寸數量
    For intI = 1 To intFieldAmount                                                                              '行填入位置
Set cellClass = Range(Cells(intRow + (strField - 1) * 21 + intI - 1, IIf(intRange = 1, MSC, WSC)), _
                Cells(intRow + (strField - 1) * 21 + intI - 1, IIf(intRange = 1, MSC, WSC)))        '欄位名稱
Set cellData = Range(Cells(intRow + (strField - 1) * 21 + intI - 1, IIf(intRange = 1, MSD, WSD)), _
                Cells(intRow + (strField - 1) * 21 + intI - 1, IIf(intRange = 1, MSD, WSD)))        '欄位資料
      If Not rstSubtotal.EOF Then
        cellClass.value = fldClass
        cellData.value = fldAmount
        rstSubtotal.MoveNext
      Else
        '清除項目內容
        cellClass.ClearContents
        cellData.ClearContents
      End If
    Next intI
    
    rstSubtotal.Close
    Set rstSubtotal = Nothing

End Sub