78 lines
2.7 KiB
VB.net
78 lines
2.7 KiB
VB.net
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
|
|
|
|
|
|
|
|
|
|
|
|
|