79 lines
3.0 KiB
VB.net
79 lines
3.0 KiB
VB.net
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
|
|
|
|
|