Attribute VB_Name = "工作表9"
'**************** 程式變數 ******************
'Const PYEAR = 2020                              '年度
'Const PCOMPANY = 11                             '公司代碼
'Const strXLSfile = "\制服.xlsm"                 '資料來源
'Const strLookup = "中油嘉義"                  '使用程式的學校
Const ITEMcount = 5                             '匯入處理品項數目
Const intFieldAmount = 22                       '表中欄位數目
Const xlsRANGE = "[引數$J1:K23]"              '排序引數表中位置
Const intFLeft = 23                             '填入表格左邊界

Private Sub CommandButton1_Click()
Dim strSQL As String
On Error GoTo Err_cmdYes_Click

Application.Calculation = xlManual '設置手動重算
'查詢欄位名稱table
Dim Cnxn As New ADODB.Connection
Set Cnxn = Cnxnopen(XLSfile, "1")

   Range("W2:AF28").Clear              '清除使用範圍儲存格
   Call FfName(Cnxn, "校裙", 2)
'    Call FfName(Cnxn, "短袖", 9)
'    Call FfName(Cnxn, "長褲", 16)
'    Call FfName(Cnxn, "夾克", 23)
'
Application.Calculation = xlAutomatic ' 設置自動重算
Cnxn.Close
Set Cnxn = Nothing

Exit_cmdYes_Click:
   Exit Sub

Err_cmdYes_Click:
   MsgBox Err.Description
   Resume Exit_cmdYes_Click

End Sub

Private Sub FfName(Cnxn As ADODB.Connection, strItem As String, intRow As Integer)
' intRange  男、女、全      1,2,3
' intRow    填表行位置
Dim rstFfname As New ADODB.Recordset
Dim strSQL As String
Dim intRowLoc As Integer
           'select 尺碼,男人數,男數量,女人數,女數量,合計
   strSQL = "Select " & strItem & "尺碼,sum(IIf(性別='男',1,0))," & "sum(IIf(性別='男'," & strItem & "訂購,0))," & _
           "sum(IIf(性別='男',0,1)),sum(IIf(性別='男',0," & strItem & "訂購))," & "sum(" & strItem & "訂購)," & xlsRANGE & ".id " & _
           "FROM [異動$] INNER JOIN " & xlsRANGE & " ON " & xlsRANGE & ".strorder = [異動$]." & strItem & "尺碼" & _
           " WHERE isnull([異動$].員編)" & _
           " GROUP BY " & xlsRANGE & ".id,[異動$]." & strItem & "尺碼" & _
           " ORDER BY " & xlsRANGE & ".id;"
'    Debug.Print strSQL
   rstFfname.Open strSQL, Cnxn, adOpenStatic, adLockOptimistic, adCmdText
   '填入項目
   For intJ = 1 To WorksheetFunction.RoundUp(rstFfname.RecordCount / intFieldAmount, 0)         '行數目限制
       intRowLoc = IIf(intJ <> 1, intRow + (2 * (intJ - 1)), intRow)                       'intJ表一範圍
   For intI = 1 To intFieldAmount
     If Not rstFfname.EOF Then
       For intK = 0 To 5                                         '行填入位置
           Cells(intRowLoc + intK, intFLeft + intI).Borders.LineStyle = xlContinuous
           Cells(intRowLoc + intK, intFLeft + intI).value = rstFfname.Fields(intK)
       Next intK
       rstFfname.MoveNext
     End If
   Next intI
   Next intJ
rstFfname.Close
Set rstFfname = Nothing

End Sub