加入 CodeStore VBA 模組

CodeStore/index.xlsm_工作表4.bas

@@ -0,0 +1,99 @@
+Attribute VB_Name = "工作表4"
+'**************** 程式變數 **********************
+Const PYEAR = 2024                      '年度
+Const PCOMPANY = 27
+Const strXLSfile = "\index.xlsb"         '資料來源
+'************************************************
+
+Private Sub CommandButton21_Click()
+Dim strSQL As String
+On Error GoTo Err_cmdYes_Click
+
+' 匯入資料
+    Call updSELLUP
+    
+Exit_cmdYes_Click:
+    Exit Sub
+
+Err_cmdYes_Click:
+    MsgBox Err.Description
+    Resume Exit_cmdYes_Click
+
+End Sub
+
+' 匯入量身資料
+Public Sub updSELLUP()
+'====================================+
+Dim p As Long                       '|
+Dim diag As New ProgressDialogue    '|
+'====================================+
+Dim sb As StringBuilder
+Set sb = New StringBuilder
+Dim rstItem As New ADODB.Recordset
+Dim rstTBL As New ADODB.Recordset               'excel資料表
+Dim strSQL, strSQLitem As String
+Dim fld As ADODB.Field
+Dim Cnxn, Cnmy As ADODB.Connection
+Set Cnmy = Cnmyopen()
+Set Cnxn = Cnxnopen(XLSfile, "1")
+    
+    sb.Append "Select " & PYEAR & PCOMPANY & " & Format([編號],'0000') AS ID,[班ID] as depart,[性別] as sex" & _
+        ", [校短尺碼] as itsz1, [校短訂購] as item1, [校長尺碼] as itsz2, [校長訂購] as item2, [校夏尺碼] as itsz3, [校夏訂購] as item3" & _
+        ", [校冬尺碼] as itsz4, [校冬訂購] as item4, [校裙尺碼] as itsz5, [校裙訂購] as item5" & _
+        ", [背心尺碼] as itsz6, [背心訂購] as item6, 0 as itsz7, [書包訂購] as item7, 0 as itsz8, [領帶訂購] as item8, 0 as itsz9, [腰帶訂購] as item9" & _
+        " FROM [帳務$];"
+' Debug.Print sb.toString
+With rstTBL
+    .Open sb.ToString, Cnxn, adOpenStatic, adLockOptimistic, adCmdText
+    lastdepart = !depart
+'====================================================================================+
+p = 0                                                                               '|
+diag.Configure "更新資料時間", "Now wasting your time...", 0, .RecordCount          '|
+diag.Show                                                                           '|
+'====================================================================================+
+    strSQLitem = "SELECT pno,mtmodel,mtname,mtcolor,wtmodel,wtname,wtcolor,tomeasure FROM GoodsUse" & _
+            " WHERE corp_use=" & PCOMPANY & " and Depart_Use=" & !depart & _
+            " order by pno;"
+    rstItem.Open strSQLitem, Cnmy
+    While Not (.EOF Or diag.cancelIsPressed)
+        If Not lastdepart = !depart Then
+            rstItem.Close
+            strSQLitem = "SELECT pno,mtmodel,mtname,mtcolor,wtmodel,wtname,wtcolor,tomeasure FROM GoodsUse" & _
+                    " WHERE corp_use=" & PCOMPANY & " and Depart_Use=" & !depart & _
+                    " order by pno;"
+            rstItem.Open strSQLitem, Cnmy
+'    Range("AF3").CopyFromRecordset rstItem
+        End If
+        i = 1
+        rstItem.MoveFirst
+        sb.Clear
+        sb.Append "UPDATE SELLUP SET "
+        '資料來源動態設定
+        While Not rstItem.EOF
+            sb.Append "itsz" & i & "=goodsid('" & .Fields.item("itsz" & i) & "'," & IIf(!sex = "男", rstItem!mtmodel, rstItem!wtmodel) & ")," & _
+                "item" & i & "=" & .Fields.item("item" & i)
+            i = i + 1
+            rstItem.MoveNext
+            If Not rstItem.EOF Then sb.Append ","
+        Wend
+        sb.Append " WHERE id=" & !ID & ";"
+Debug.Print sb.ToString
+        ' Cnmy.Execute sb.toString
+        lastdepart = !depart
+        .MoveNext
+'================================================+
+diag.SetValue p                                 '|
+diag.SetStatus "Now wasting your time... " & p  '|
+p = p + 1                                       '|
+'================================================+
+    Wend
+'============+
+diag.Hide   '|
+'============+
+    .Close
+End With
+    Cnxn.Close
+
+End Sub
+
+