加入 CodeStore VBA 模組

2026-08-18 00:39:40 +08:00
1 parent 9c5364f88e
commit 0e638bdd15
@@ -0,0 +1,78 @@
+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
+
+